DEFINE PROCEDURE STORE_domname 
READY domname 	SHARED WRITE
!************************************************************
!* PROGRAM NAME:	STORE_domname 
!* DICTIONARY:				
!* PROGRAMMER: 		pgmname 
!* DATE WRITTEN:	pgmtime 
!* LANGUAGES:		DATATRIEVE
!* UTILITIES:		FMS
!* PROCEDURES CALLED:	NONE
!*			
!* PROCEDURE CALLED FROM:	NONE	
!* ASSOCIATED COMMAND PROCEDURE:
!* I-O FILES:		domname  
!* OUTPUT FILES:	TERMINAL
!* MAIN USER:		
!*			
!* COMMENTS:		INTERACTIVE EDIT/UPDATES FOR THE domname 
!* MODIFICATION:			
!* MOD. DATE:		
!* REASON FOR MOD.	
!************************************************************
!  AN X PRECEDING A VARIABLE NAME INDICATES THE USE OF A WORKING STORAGE AREA
DECLARE XANS		PIC X	VALID IF XANS = "Y", "N", "y", "n".
    					!ACCEPTS USER INPUT
DECLARE Xkeyname 	PIC keypic .
DECLARE XUPDATE		PIC X	VALID IF XUPDATE = "A","a","C","c","D","d",
    					"E", "e".
    					!TYPE OF UPDATE:A=ADD;C=CHANGE;D=DELETE
! AN T PRECEDING A VARIABLE NAME IS USED FOR TEMPLATES
DECLARE TANS		PIC X	VALID IF TANS = "Y", "N", "y", "n".
DECLARE TEMPLATE_FOUND_FLAG  PIC X.
DECLARE Tkeyname 	PIC keypic.
DECLARE ERRORFLAG	PIC 9.		
DECLARE FOUNDFLAG	PIC 9.		!MATCHING domname RECORD
!*******END OF DECLARATIONS
XUPDATE = *."A for add, C for change, D for delete, or E to exit (A/C/D/E)"
WHILE XUPDATE NOT = "E", "e"
BEGIN
    Xkeyname  = *."the keyname "		!*******GET KEY
    !*****CHECK FOR MATCHING domname RECORD
    FOUNDFLAG = 0
    FOR FIRST 1 domname  WITH keyname  = Xkeyname 
    BEGIN
    	FOUNDFLAG = 1
    END
    IF (XUPDATE = "A", "a") THEN
    BEGIN
    	ERRORFLAG = 0
    	FOR ALL domname WITH keyname = Xkeyname 
    		ERRORFLAG = 1
    	IF ERRORFLAG = 0
    	BEGIN
    	TANS = *."Y to use a template or N not to use a template"
    	IF (TANS = "Y", "y") THEN
    	BEGIN
             	Tkeyname  = *."the template's KEYNAME "
    		Tkeyname  = FN$UPCASE(Tkeyname)
    		TEMPLATE_FOUND_FLAG	= 0
        	FOR FIRST 1 HOLD IN domname WITH keyname = Tkeyname 
        	BEGIN
    	        	TEMPLATE_FOUND_FLAG 	= 1
    			STORE domname USING
    			BEGIN
				domname_REC 	= HOLD.domname_rec 
				keyname 	= Xkeyname 
    			END
    		END
        	IF (TEMPLATE_FOUND_FLAG = 0)	PRINT "Template not found"
    	END
    END
    END
    IF (XUPDATE = "C", "c" 	AND FOUNDFLAG = 1) 	OR
       (XUPDATE = "A", "a" 	AND TANS = "Y", "y"    	AND 
        TEMPLATE_FOUND_FLAG = 1) THEN
    BEGIN
    	    FOR FIRST 1 domname WITH keyname = Xkeyname 
    	    BEGIN
    		DISPLAY_FORM frmname IN flbname USING
    		BEGIN
    			PUT_FORM keyname 	= Xkeyname 
***PUT_FORM here
    		END RETRIEVE USING
    		BEGIN
    			XANS	= GET_FORM XANS
    			IF (XANS = "Y", "y") THEN MODIFY USING
    			BEGIN
***GET_FORM here
    			END
       			IF (XANS = "N", "n"    AND TANS = "Y"," y"	AND
    			    XUPDATE = "A", "a" AND TEMPLATE_FOUND_FLAG = 1)
    				ERASE;
    		END
    	    END
    END
    IF XUPDATE = "D", "d" AND FOUNDFLAG = 1 THEN
    BEGIN
    	FOR ALL domname WITH keyname = Xkeyname 
    	BEGIN
    		ERASE;
    		PRINT "Record erased"
    	END
    END
    IF (XUPDATE = "D", "d", "C", "c" AND FOUNDFLAG = 0)
        PRINT "RECORD NOT FOUND - REENTER"
    IF XUPDATE = "A", "a" AND FOUNDFLAG = 0	AND
       TANS = "N", "n"
    BEGIN
    	DISPLAY_FORM frmname IN flbname USING
    	BEGIN
    		PUT_FORM keyname 	= Xkeyname 
    	END RETRIEVE USING
    	BEGIN
    		XANS	= GET_FORM XANS
		IF XANS = "Y", "y" THEN STORE domname USING
		BEGIN
    			keyname	= Xkeyname 
***GET_FORM here
		END
    	END
    END
    IF (XUPDATE = "A", "a" AND FOUNDFLAG = 1)
        PRINT "RECORD ALREADY EXISTS - REENTER"
    XUPDATE = *."A for add, C for change, D for delete, or E to exit (A/C/D/E)"
END
END-PROCEDURE