*S****SAG GENERATOR: WW-OBJECT-MAINT-DIALOG           Version: 3.2.2    
*S****SAG TITLE: ADD Maintenance    
*S****SAG SYSTEM: FINANCIER         
*S****SAG GDA: WWGDA    
*S****SAG DESCS(1): This program maintains student identification       
*S****SAG DESCS(2): information in the WF-ADD file.         
*S****SAG HEADER1: FINANCIER        
*S****SAG DIRECT-COMMAND-PROCESS:   
*S****SAG ACTIONS: 0101010100010000 
*S****SAG OBJECT-NAME: WFADDDSO     
*S****SAG MAX-WINDOWS: 1
*S****SAG MAP-NAME(1): WFADDMTM     
*S*************************************************************************         
*S***       
*S***                              WolffPack    
*S***       
*S*** Program  : WFADDMTP           
*S*** System   : FINANCIER          
*S*** Title    : ADD Maintenance    
*S*** Generated: Nov 24,98 at 05:23 PM          
*S*** Function : This program maintains student identification          
*S***            information in the WF-ADD file.
*S***       
*S***       
*S***       
*S***      Copyright 1995 - 2006 WolffPack, Inc.  All rights reserved.  
*S***       
*S*************************************************************************         
*S**DEFINE DATA         
*S**  GLOBAL USING WWGDA
*S***       
*S**  LOCAL USING WFADDDSD /* Passed to object subprogram   
*S**  LOCAL USING WFADDDSR /* Passed to object subprogram   
*S**  LOCAL USING WFADDDSS /* Shadow file       
*S**  LOCAL USING WWAOBJ   /* Used by object subprograms    
*S***       
*S**  LOCAL USING WWCONST  /* Constants         
*S**  LOCAL USING WWDIALDA /* Common data for dialog objects.           
*S**  LOCAL USING WWENVIRA /* Used to capture/restore previous environment.         
*S**  LOCAL USING WWKEYLDA /* Used to set function keys and names.      
*S**  LOCAL USING WWVALLDA /* Used by valid values/edit mask routine    
*S**  LOCAL 
*S****SAG DEFINE EXIT SECURITY-PGM  
*S**  /*    
*S**  /* Security program exit      
*S**  01 #SECURITY-PROGRAM(A8) INIT<'WFADDBRP'> 
*S****SAG END-EXIT      
*S****SAG DEFINE EXIT EVENT-HISTORY 
*S**  /*    
*S**  /* Literals utilized by Event History routine         
*S**  01 #EVENT-TYPE(A5) CONST<' '> 
*S**  01 #EVENT-DESC(A40) CONST<' '>
*S****SAG END-EXIT      
*S****SAG DEFINE EXIT REQUIREMENTS  
*S**  /*    
*S**  /* Variables Requirement routine          
*S**  01 #REQMNTS(3)    
*S**    02 #REQMNT-TYPE(A1)              /* (A/Application, D/Disbursement)         
*S**        INIT (1)<' '> (2)<' '> (3)<' '>     
*S**    02 #REQMNT-DOC(A6)               /* Document mnemonic           
*S**        INIT (1)<' '> (2)<' '> (3)<' '>     
*S**    02 #REQMNT-PD(A2)                /* (ST/Student, AY/Aid Year)   
*S**        INIT (1)<' '> (2)<' '> (3)<' '>     
*S****SAG END-EXIT      
*S***       
*S*** Scalar Constants. 
*S**  01 #SUB-PARM(A1)  
*S***       
*S*** Miscellaneous Variables.      
*S**  01 #NEXT(L)                        /* Next processing selected    
*S**  01 #DISPLAYED-KEY(A16) /* Last record found           
*S**  01 #TYPE-POS(P3)  
*S**  01 #KEY(A16)  /* Key field copied from map.           
*S**  01 #NEW-OBJECT(L)         /* GET was done on different object     
*S**  01 #BYPASS-OBJECT(L)      /* I/O was done via subprogram          
*S**  01 #BYPASS-INPUT(L)       /* do not perform input statement       
*S**  01 #NULL-KEY(A16) 
*S****SAG DEFINE EXIT LOCAL-DATA    
*S***       
*S**  LOCAL USING WWNAMECL          
*S**  LOCAL 
*S**    01 #SUBPGM(A8)  
*S**    01 #AID-CCYY(A4)
*S**    01 REDEFINE #AID-CCYY       
*S**      02 #AID-CC(A2)
*S**      02 #AID-YY(A2)
*S**    01 #PASS-DOB(A8)
*S**    01 #PASS-STAT(A1)           
*S**    01 #PASS-EXISTS(L)          
*S**    01 #CHECK-REJECT(A1)        
*S**    01 #ADD-SOURCE(A1)          
*S***       
*S**    01 #ORIG-NAME(A35)          
*S**    01 #ORIG-SSN(A9)
*S**    01 #ORIG-DOB(D) 
*S**    01 #ORIG-NL(A20)
*S**    01 #ORIG-NF(A20)
*S**    01 #ORIG-NM(A1) 
*S**    01 #HOLD-SSN(A9)
*S***       
*S**   01 #PARAMETER-FIELDS         
*S**     02 #PGM-PARAMETERS         
*S**       03 #EARLIER-REC(A1)      
*S**       03 #FED-REJ-CASE(A1)     
*S**       03 #OVRD-FED-REJ(A1)     
*S**       03 #OVRD-C-PEND(A1)      
*S**       03 #OVRD-C-XMIT(A1)      
*S**       03 #OVRD-LOCKED(A1)      
*S**       03 #OVRD-VERIFD(A1)      
*S**       03 #OVRD-PACKGD(A1)      
*S**     02 #PASSED-PARAMETERS      
*S**       03 #INPUT-COUNTER(P7)    
*S**       03 #NEW-REJ-COUNTER(P7)  
*S**       03 #RE-REJ-COUNTER(P7)   
*S**       03 #BYPASS-COUNTER(P7)   
*S**       03 #ADD-RECORD-COUNTER(P7)           
*S**       03 #PROCESSED-RECORD(L)  
*S****SAG END-EXIT      
*S**END-DEFINE          
*S***       
*S***       
*S*** Define Formats    
*S**FORMAT PS=23 KD=ON LS=133 ZP=OFF
*S***       
*S**PERFORM INITIALIZATIONS         
*S***       
*S*************************************************************************         
*S***       
*S**PROG.   
*S**REPEAT                                           /* until exit action           
*S**  /*    
*S**NEW-SCREEN.         
*S**  REPEAT   /* Escape this repeat with indexes set as desired.       
*S**    /*  
*S**    /*  Security / Required fields          
*S**    /*    Perform first time and/or new student (set via Selection) 
*S**    IF #DISPLAYED-KEY = #NULL-KEY           
*S**      MOVE 'WFADDDSD' TO ##FILE-ID          
*S**      MOVE #SECURITY-PROGRAM TO ##PGM-ID    
*S**      PERFORM ADD-SECURITY ADD-CNTL-VARS    
*S**      RESET INITIAL ADD-LOGICALS
*S****SAG DEFINE EXIT AFTER-SECURITY
*S**      ASSIGN #ADD-SOURCE = ##PASS-KEY       
*S****SAG END-EXIT      
*S**      /*
*S**      PERFORM REQUIRED-FIELD-CHECK REQUIRED-FIELD(*)    
*S**      PERFORM SET-KEYS          
*S**    END-IF          
*S**    /*  
*S**    /* Load appropriate function
*S**    IF *PF-KEY = WWKEYLDA.#PURGE-KEY OR     
*S**       #CONFIRM-PURGE           
*S**      ASSIGN #FUNCTION = 'DELETE'           
*S**      IF NOT #CONFIRM-PURGE     
*S**        ASSIGN #BYPASS-OBJECT = TRUE        
*S**      END-IF        
*S**    ELSE
*S**      IF #ADD-OBJECT
*S**        ASSIGN #FUNCTION = 'STORE'          
*S**        RESET #ADD-OBJECT       
*S**      ELSE          
*S**        IF #DISPLAYED-KEY NE #KEY           
*S**           OR #KEY = #NULL-KEY  
*S**          ASSIGN #FUNCTION = 'GET'          
*S**        ELSE        
*S**          ASSIGN #FUNCTION = 'UPDATE'       
*S**        END-IF      
*S**      END-IF        
*S**    END-IF          
*S****SAG DEFINE EXIT BEFORE-CALL-OBJECT        
*S**    /*  
*S**    /* Load key information from the GDA    
*S**    IF #FUNCTION = 'GET'        
*S**      ASSIGN WFADDDSD.WW-ST-SSN = ##SSN     
*S**      ASSIGN WFADDDSD.WF-FAO = ##FAO-ID     
*S**      ASSIGN WFADDDSD.WF-AID-YEAR = ##AID-YEAR          
*S**      ASSIGN WFADDDSD.WF-AD-SOURCE = #ADD-SOURCE        
*S**      ASSIGN #ORIG-NAME = ##COMP-NAME       
*S**    END-IF          
*S****SAG END-EXIT      
*S**    /*  
*S**    /* Perform object I/O subprogram        
*S**    IF #BYPASS-OBJECT           
*S**      RESET #BYPASS-OBJECT      
*S**    ELSE
*S**      PERFORM CALL-OBJECT       
*S**    END-IF          
*S****SAG DEFINE EXIT AFTER-CALL-OBJECT         
*S**    /*  
*S**    /* Additional processing before calling the main    
*S**    /*  object subprogram       
*S**    IF ##MSG = 'Record purged successfully' 
*S**      ASSIGN ##MSG = 'Application purged'   
*S**      ESCAPE BOTTOM(PROG.) IMMEDIATE        
*S**    END-IF          
*S**    /*  
*S**    IF #FUNCTION = 'GET'        
*S**      MOVE WFADDDSD.WW-ST-SSN TO #ORIG-SSN  
*S**      MOVE WFADDDSD.WW-ST-DOB TO #ORIG-DOB  
*S**      MOVE WFADDDSD.WW-ST-NM-LAST TO #ORIG-NL           
*S**      MOVE WFADDDSD.WW-ST-NM-FIRST TO #ORIG-NF          
*S**      MOVE WFADDDSD.WW-ST-NM-MI TO #ORIG-NM 
*S**    END-IF          
*S**    /*  
*S**    MOVE EDITED WFADDDSD.WW-ST-DOB(EM=MMDDYYYY) TO #PASS-DOB        
*S**    PERFORM DETERMINE-SID ##SSN 
*S**                          WFADDDSD.WW-ST-NM-LAST        
*S**                          WFADDDSD.WW-ST-NM-FIRST       
*S**                          WFADDDSD.WW-ST-NM-MI          
*S**                          #PASS-DOB         
*S**                          ##SID 
*S**    PERFORM GET-STUDENT-KEY     
*S**    PERFORM GET-STUDENT-INFO    
*S**    IF NOT ##STUDENT-REC        
*S**      ASSIGN ##SSN = WFADDDSD.WW-ST-SSN     
*S**      ASSIGN ##DOB = WFADDDSD.WW-ST-DOB     
*S**      ASSIGN ##COMP-NAME = #ORIG-NAME       
*S**    END-IF          
*S****SAG END-EXIT      
*S**    /*  
*S**    /* Load shadow file definitions for appropriate map 
*S**    IF NOT #CONFIRM-PURGE       
*S**      MOVE LOAD TO #SUB-PARM    
*S**      PERFORM CALL-EXT-SUB      
*S**    END-IF          
*S**    /*  
*S**    /* Assign appropriate message           
*S**    IF ##MSG = SPACE
*S**      DECIDE ON FIRST VALUE OF #FUNCTION    
*S**        VALUE 'GET' 
*S**          IF #ADD-OBJECT        
*S**            COMPRESS 'This information not currently stored for #TEMP,'         
*S**              'ready to add' INTO ##MSG     
*S**          ELSE      
*S**            COMPRESS 'To modify the current #TEMP information,'     
*S**              'make changes and press ENTER' INTO ##MSG 
*S**          END-IF    
*S**        VALUE 'NEXT'
*S**          COMPRESS 'Next #TEMP information has been displayed'      
*S**            INTO ##MSG          
*S**        VALUE 'UPDATE'          
*S**          COMPRESS '#TEMP information has been modified'
*S**            INTO ##MSG          
*S**        VALUE 'STORE'           
*S**          COMPRESS '#TEMP information has been added'   
*S**            INTO ##MSG          
*S**        VALUE 'DELETE'          
*S**          IF #CONFIRM-PURGE     
*S**            COMPRESS '#TEMP information has been purged'
*S**              INTO ##MSG        
*S**          ELSE      
*S**            COMPRESS 'Press ENTER to confirm purge'     
*S**              INTO ##MSG        
*S**          END-IF    
*S**        ANY         
*S**          EXAMINE ##MSG FOR '#TEMP' AND REPLACE WITH ##SYSTEM-DATA-TYPE         
*S**          EXAMINE ##MSG FOR ##SYSTEM-DATA-TYPE GIVING POSITION #TYPE-POS        
*S**          IF #TYPE-POS = 1      
*S**            EXAMINE SUBSTRING(##MSG,1,1) AND TRANSLATE INTO UPPER CASE          
*S**          END-IF    
*S**        NONE        
*S**          IGNORE    
*S**      END-DECIDE    
*S**    END-IF          
*S****SAG DEFINE EXIT DEFINE-WINDOW 
*S**    /*  
*S**    /*  Define Window attributes
*S**    DEFINE WINDOW ADDMAINT      
*S**           SIZE 19*63           
*S**           BASE 2 / 9           
*S**           TITLE 'ADD File Maintenance'     
*S**           CONTROL SCREEN       
*S**           FRAMED ON (CD=NE)    
*S**           POSITION OFF         
*S**    SET WINDOW 'ADDMAINT'       
*S**    ASSIGN ##COLOR = 'NE'       
*S****SAG END-EXIT      
*S**    /*  
*S**    /* INPUT processing         
*S****SAG DEFINE EXIT BEFORE-INPUT  
*S**    /*  
*S**    /* Protect correction flags if not federal (ISIR) input         
*S**    IF WFADDDSD.WF-AD-SOURCE NE 'F'         
*S**      MOVE NON-DISPLAY-PROT-ATTR TO AD-C-SSN-CV AD-C-DOB-CV         
*S**                                    AD-C-NL-CV  AD-C-NF-CV  AD-C-NM-CV          
*S**    END-IF          
*S****SAG END-EXIT      
*S**    /*  
*S**    /* Input Map    
*S**    IF NOT #BYPASS-INPUT        
*S**      INPUT WITH TEXT ##MSG,    
*S**                      ##MSG-DATA(1),##MSG-DATA(2),##MSG-DATA(3)     
*S**            USING MAP 'WFADDMTM'
*S**    END-IF          
*S**    /*  
*S**    RESET ##MSG     
*S**    /*  
*S**    /* Purge processing must be confirmed   
*S**    IF WWAOBJ.#FUNCTION = 'DELETE' AND      
*S**       *PF-KEY = 'ENTR'         
*S**      IF NOT #CONFIRM-PURGE     
*S**        ASSIGN #CONFIRM-PURGE = TRUE        
*S**      END-IF        
*S**    END-IF          
*S**    /*  
*S**    /*  
*S**    /* Check standard PF-Keys   
*S****SAG DEFINE EXIT BEFORE-STD-KEY-PROCESSING 
*S**    /*  
*S**    /* Processing to be performed prior to 'standard key' processing
*S**    IF *PF-KEY = WWKEYLDA.#EXPAND-KEY       
*S**      MOVE ##AID-YEAR TO #AID-CCYY          
*S**      IF WFADDDSD.WF-AD-SOURCE = 'F'        
*S**        COMPRESS 'WFAFC' #AID-YY 'P' INTO #SUBPGM LEAVING NO        
*S**      ELSE          
*S**        IF WFADDDSD.WF-AD-SOURCE = 'G'      
*S**          COMPRESS 'WFAGC' #AID-YY 'P' INTO #SUBPGM LEAVING NO      
*S**        ELSE        
*S**          REINPUT 'Expansion not available for this source' ALARM   
*S**        END-IF      
*S**      END-IF        
*S**      FETCH RETURN #SUBPGM      
*S**      PERFORM SET-KEYS          
*S**      ESCAPE TOP    
*S**    END-IF          
*S**    /*  
*S**    /* Print key used to supply online call to ADD load process     
*S**    /*  (assume edits bypass)   
*S**    IF *PF-KEY = WWKEYLDA.#PRINT-KEY        
*S**      /*
*S**      /* Check conditions that cannot be overridden     
*S**      /*  ACG record without ISIR record    
*S**      IF WFADDDSD.WF-AD-SOURCE = 'G'        
*S**        PERFORM GET-ISIR-EXISTENCE #PASS-EXISTS         
*S**        IF NOT #PASS-EXISTS                 /* Record does not exist
*S**          MOVE 'G' TO #CHECK-REJECT         
*S**          PERFORM PROCESS-REJECT
*S**        END-IF      
*S**      END-IF        
*S**      /*
*S**      /*  NCP record without Profile record 
*S**      IF WFADDDSD.WF-AD-SOURCE = 'N'        
*S**        PERFORM GET-CSS-STATUS #PASS-STAT   
*S**        IF #PASS-STAT = ' '                 /* Record does not exist
*S**          MOVE '2' TO #CHECK-REJECT         
*S**          PERFORM PROCESS-REJECT
*S**        END-IF      
*S**      END-IF        
*S**      IF #CHECK-REJECT = ' '    
*S**        /*          
*S**        /* Call subroutine to load data and perform appropriate calcs           
*S**        RESET ##PASS-ACTION     
*S**        ASSIGN WFADDDSD.WF-AD-REJ-OVERRIDE = 'O'        
*S**        MOVE 'Y' TO #OVRD-FED-REJ           
*S**                    #OVRD-C-PEND
*S**                    #OVRD-C-XMIT
*S**                    #OVRD-LOCKED
*S**                    #OVRD-VERIFD
*S**                    #OVRD-PACKGD
*S**        PERFORM LOAD-STUDENT #PARAMETER-FIELDS          
*S**                             WFADDDSD WFADDDSD-ID       
*S**      END-IF        
*S**      IF #PROCESSED-RECORD      
*S**        /*          
*S**        /* Purge ADD record     
*S**        ASSIGN WWAOBJ.#FUNCTION = 'DELETE'  
*S**        CALLNAT 'WFADDDSO' WW-GDA           
*S**                 WFADDDSD       
*S**                 WFADDDSD-ID    
*S**                 WFADDDSR       
*S**                 WWAOBJ         
*S**        END TRANSACTION         
*S**        ASSIGN ##MSG = 'Application loaded' 
*S**      ELSE          
*S**        ASSIGN ##MSG = 'Application not loaded'         
*S**      END-IF        
*S**      ESCAPE BOTTOM(PROG.) IMMEDIATE        
*S**    END-IF          
*S****SAG END-EXIT      
*S**    INCLUDE WWSTDKEY
*S**    /*  
*S**    /* Trap invalid PF-Keys.    
*S**    IF *PF-KEY = 'ENTR' OR = WWKEYLDA.#SELECT-KEY       
*S**       OR = WWKEYLDA.#PURGE-KEY 
*S**      IGNORE        
*S**    ELSE
*S**      REINPUT 'Invalid program function key' ALARM      
*S**    END-IF          
*S**    /*  
*S**    /* Don't allow purge on non-existent record         
*S**    IF *PF-KEY = WWKEYLDA.#PURGE-KEY AND    
*S**       #ADD-OBJECT  
*S**      REINPUT 'Cannot purge non-existent record' ALARM  
*S**    END-IF          
*S**    /*  
*S**    /* Perform edit routine     
*S**    RESET INITIAL #FAIL-EDIT    
*S**    MOVE EDIT TO #SUB-PARM      
*S**    PERFORM CALL-EXT-SUB        
*S**    IF #FAIL-EDIT   
*S**      REINPUT FULL 'Edit errors occurred'   
*S**              MARK #MARK-FIELD ALARM        
*S**    END-IF          
*S**    /*  
*S*************************************************************************         
*S**DEFINE SUBROUTINE NEW-SCREEN    
*S*************************************************************************         
*S**  /*    
*S**  /* Subroutine to allow escape from screen loop        
*S**  ESCAPE BOTTOM(NEW-SCREEN.) IMMEDIATE      
*S**END-SUBROUTINE /* NEW-SCREEN    
*S**  /*    
*S**  END-REPEAT /* on NEW-SCREEN   
*S**END-REPEAT /* on Repeat of Program.         
*S***       
*S**PERFORM FINAL-PROCESSING        
*S***       
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE CALL-EXT-SUB  
*S*************************************************************************         
*S**  /*    
*S**  /* Call Map specific external subroutine  
*S**  PERFORM WFADDMTM-MASK-EDITS #SUB-PARM WWVALLDA        
*S**          WFADDDSD WFADDDSD-ID WFADDDSR WFADDDSS        
*S**END-SUBROUTINE /* CALL-EXT-SUB  
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE CALL-OBJECT   
*S*************************************************************************         
*S**  /*    
*S**  /* Prior to processing object 
*S**  IF WWAOBJ.#FUNCTION = 'DELETE'
*S**    RESET #CONFIRM-PURGE        
*S**  END-IF
*S****SAG DEFINE EXIT BEFORE-OBJECT-CALL        
*S**/*      
*S**/* If SSN correction, delete old record and set up for add of new   
*S**  IF WWAOBJ.#FUNCTION = 'UPDATE'
*S**    IF WFADDDSD.WW-ST-SSN NE #ORIG-SSN      
*S**      MOVE WFADDDSD.WW-ST-SSN TO #HOLD-SSN  
*S**      MOVE #ORIG-SSN TO WFADDDSD.WW-ST-SSN  
*S**      MOVE 'DELETE' TO WWAOBJ.#FUNCTION     
*S**      CALLNAT 'WFADDDSO' WW-GDA 
*S**               WFADDDSD         
*S**               WFADDDSD-ID      
*S**               WFADDDSR         
*S**               WWAOBJ           
*S**      RESET ##MSG   
*S**      MOVE #HOLD-SSN TO WFADDDSD.WW-ST-SSN ##SSN        
*S**      MOVE 'STORE' TO WWAOBJ.#FUNCTION      
*S**    END-IF          
*S**  END-IF
*S**/*      
*S**/* Additional processing before calling the main object subprogram  
*S**  IF WWAOBJ.#FUNCTION = 'UPDATE' OR = 'STORE'           
*S**   IF WFADDDSD.WF-AD-SOURCE = 'F'           
*S**    IF WFADDDSD.WW-ST-SSN NE #ORIG-SSN      
*S**      MOVE 'S' TO WFADDDSD.WF-AD-C-SSN      
*S**      MOVE WFADDDSD.WW-ST-SSN TO #ORIG-SSN  
*S**    END-IF          
*S**    IF WFADDDSD.WW-ST-DOB NE #ORIG-DOB      
*S**      MOVE 'B' TO WFADDDSD.WF-AD-C-DOB      
*S**      MOVE WFADDDSD.WW-ST-DOB TO #ORIG-DOB  
*S**    END-IF          
*S**    IF WFADDDSD.WW-ST-NM-LAST NE #ORIG-NL   
*S**      MOVE 'L' TO WFADDDSD.WF-AD-C-NL       
*S**      MOVE WFADDDSD.WW-ST-NM-LAST TO #ORIG-NL           
*S**    END-IF          
*S**    IF WFADDDSD.WW-ST-NM-FIRST NE #ORIG-NF  
*S**      MOVE 'F' TO WFADDDSD.WF-AD-C-NF       
*S**      MOVE WFADDDSD.WW-ST-NM-FIRST TO #ORIG-NF          
*S**    END-IF          
*S**    IF WFADDDSD.WW-ST-NM-MI NE #ORIG-NM     
*S**      MOVE 'M' TO WFADDDSD.WF-AD-C-NM       
*S**      MOVE WFADDDSD.WW-ST-NM-MI TO #ORIG-NM 
*S**    END-IF          
*S**   END-IF           
*S**  END-IF
*S****SAG END-EXIT      
*S**  /*    
*S**  /* Assign #KEY to equal the input fields  
*S**  MOVE BY NAME WFADDDSD TO WFADDDSD-ID.STRUCTURE        
*S**  ASSIGN #KEY = WFADDDSD-ID     
*S**  /*    
*S**  /* Invoke subprogram to process object    
*S**  CALLNAT 'WFADDDSO' WW-GDA     
*S**           WFADDDSD 
*S**           WFADDDSD-ID          
*S**           WFADDDSR 
*S**           WWAOBJ   
*S**  /*    
*S**  IF WWAOBJ.#FUNCTION = 'GET' AND           
*S**     NOT WWAOBJ.#EXISTS         
*S**    ASSIGN #ADD-OBJECT = TRUE   
*S**  END-IF
*S**  /*    
*S**  ASSIGN #DISPLAYED-KEY = WFADDDSD-ID       
*S**  /*    
*S**  /* Reset #KEY if next record displayed    
*S**  IF #FUNCTION = 'NEXT'         
*S**    ASSIGN #KEY = #DISPLAYED-KEY
*S**  END-IF
*S**  /*    
*S**  /* Set logical for update processing      
*S**  IF #FUNCTION = 'STORE'        
*S**            OR = 'UPDATE'       
*S**            OR = 'DELETE'       
*S**    ASSIGN #UPDATE-PERFORMED = TRUE         
*S**  END-IF
*S**  /*    
*S**  /* Update performed           
*S**  IF #UPDATE-PERFORMED THEN     
*S**    CALLNAT 'WWDUTILN' WW-GDA WWVALLDA      
*S**    PERFORM ADD-EVENT #EVENT-TYPE #EVENT-DESC           
*S**    END TRANSACTION 
*S**    RESET #UPDATE-PERFORMED #ACTION #ADD-OBJECT #DATA-MODIFIED      
*S**  END-IF
*S****SAG DEFINE EXIT END-OBJECT-CALL           
*S**  /*    
*S**  /* Additional processing after returning from object subprogram.  
*S**  IF #FUNCTION = 'STORE'        
*S**    ASSIGN #FUNCTION = 'UPDATE' 
*S**  END-IF
*S**  /*    
*S**  COMPRESS WFADDDSD.WW-ST-NM-LAST COMMA INTO
*S**    #NAME-LAST LEAVING NO SPACE 
*S**  COMPRESS WFADDDSD.WW-ST-NM-FIRST WFADDDSD.WW-ST-NM-MI INTO        
*S**    #NAME-FIRST-MID WITH DELIMITER SPACE    
*S**  COMPRESS #NAME-LAST #NAME-FIRST-MID INTO  
*S**    ##COMP-NAME WITH DELIMITER SPACE        
*S**  MOVE ##COMP-NAME TO #ORIG-NAME
*S****SAG END-EXIT      
*S**END-SUBROUTINE /* CALL-OBJECT   
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE FINAL-PROCESSING          
*S*************************************************************************         
*S**  /*    
*S**  INCLUDE WWEND /* Restore environment.     
*S**END-SUBROUTINE /* FINAL-PROCESSING          
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE INITIALIZATIONS           
*S*************************************************************************         
*S**  /*    
*S**  INCLUDE WWBEGIN                                /* Capture environment         
*S**  SET CONTROL 'WBM'                  /* Set window size/base        
*S**  /*    
*S**  /* Specify which PF-KEYS are valid, start by resetting all keys,  
*S**  /*  then assign desired keys using RESET INITIAL.     
*S**  INCLUDE WWPFSTD /* Standard PF-Keys.      
*S****SAG DEFINE EXIT SET-PF-KEYS   
*S**  /*    
*S**  /* Set additional PF Keys     
*S**  RESET INITIAL WWKEYLDA.#NOTEPAD-KEY       
*S**                WWKEYLDA.#EXPAND-KEY        
*S****SAG END-EXIT      
*S**END-SUBROUTINE /* INITIALIZATIONS           
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE SET-KEYS      
*S*************************************************************************         
*S***       
*S****SAG DEFINE EXIT BEFORE-SET-KEY
*S**  /*    
*S**  /* Override expand key (only available on Federal and ACG records)
*S**  IF #ADD-SOURCE NE 'F' AND #ADD-SOURCE NE 'G'          
*S**    RESET WWKEYLDA.#EXPAND-KEY  
*S**  END-IF
*S****SAG END-EXIT      
*S**  INCLUDE WWSETKEY /* Set specified keys    
*S**  INCLUDE WWSETHLP /* Set Help keys         
*S**  /*    
*S**  /* Purge Key redefinition  (reuse Calc key)           
*S**  SET KEY PF5=PGM NAMED 'Purge' 
*S**  RESET INITIAL WWKEYLDA.#CALC-KEY          
*S****SAG DEFINE EXIT SET-KEYS      
*S**  /*    
*S**  /* If user has "W"rite security, turn on LOAD key     
*S**  /*   Otherwise, turn off PURGE key (generated)        
*S**  IF ##PASS-SECURITY = 'W'      
*S**    SET KEY PF6 NAMED 'Load'    
*S**    RESET INITIAL WWKEYLDA.#PRINT-KEY       
*S**  ELSE  
*S**    SET KEY PF5 NAMED OFF       
*S**    RESET WWKEYLDA.#PURGE-KEY   
*S**  END-IF
*S****SAG END-EXIT      
*S**END-SUBROUTINE /* SET-KEY       
*S****SAG DEFINE EXIT MISCELLANEOUS-SUBROUTINES 
*S***       
*S*************************************************************************         
*S**DEFINE SUBROUTINE PROCESS-REJECT
*S*************************************************************************         
*S**  /*    
*S**  IF #CHECK-REJECT = WFADDDSD.WF-AD-REJ1 OR 
*S**                   = WFADDDSD.WF-AD-REJ2 OR 
*S**                   = WFADDDSD.WF-AD-REJ3 OR 
*S**                   = WFADDDSD.WF-AD-REJ4 OR 
*S**                   = WFADDDSD.WF-AD-REJ5    
*S**    ESCAPE ROUTINE  
*S**  END-IF
*S**  DECIDE FOR FIRST CONDITION    
*S**    WHEN WFADDDSD.WF-AD-REJ1 = ' '          
*S**      ASSIGN WFADDDSD.WF-AD-NEW-REJ = 'R'   
*S**      ASSIGN WFADDDSD.WF-AD-REJ1 = #CHECK-REJECT        
*S**    WHEN WFADDDSD.WF-AD-REJ2 = ' '          
*S**      ASSIGN WFADDDSD.WF-AD-REJ2 = #CHECK-REJECT        
*S**    WHEN WFADDDSD.WF-AD-REJ3 = ' '          
*S**      ASSIGN WFADDDSD.WF-AD-REJ3 = #CHECK-REJECT        
*S**    WHEN WFADDDSD.WF-AD-REJ4 = ' '          
*S**      ASSIGN WFADDDSD.WF-AD-REJ4 = #CHECK-REJECT        
*S**    WHEN WFADDDSD.WF-AD-REJ5 = ' '          
*S**      ASSIGN WFADDDSD.WF-AD-REJ5 = #CHECK-REJECT        
*S**    WHEN ANY        
*S**      ASSIGN WWAOBJ.#FUNCTION = 'UPDATE'    
*S**      PERFORM CALL-OBJECT       
*S**    WHEN NONE       
*S**      IGNORE        
*S**  END-DECIDE        
*S**END-SUBROUTINE /* PROCESS-REJECT
*S****SAG END-EXIT      
*S**END     
