DSN8HC3
THIS MODULE DISPLAYS THE Db2 DEPARTMENT AND EMPLOYEE TABLES AND UPDATES THEM IF DESIRED.
IDENTIFICATION DIVISION. 00000100
*----------------------- 00000200
PROGRAM-ID. DSN8HC3. 00000300
00000400
*---------------------------------------------------------------* 00000500
* * 00000600
* MODULE NAME = DSN8HC3 * 00000700
* * 00000800
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION * 00000900
* ORGANIZATION APPLICATION * 00001000
* ISPF * 00001100
* COBOL * 00001200
* LICENSED MATERIALS - PROPERTY OF IBM * 00001300
* 5615-DB2 * 00001400
* (C) COPYRIGHT 1982, 2013 IBM CORP. ALL RIGHTS RESERVED. * 00001500
* * 00001600
* STATUS = VERSION 11 * 00001700
* * 00001800
* * 00001900
* * 00002000
* FUNCTION = THIS MODULE DISPLAYS THE DB2 DEPARTMENT AND * 00002100
* EMPLOYEE TABLES AND UPDATES THEM IF DESIRED. * 00002200
* * 00002300
* NOTES = * 00002400
* DEPENDENCIES = REQUIRED ISPF PANELS: * 00002500
* DSN8SSH * 00002600
* DSN8SSH1 * 00002700
* DSN8SSH2 * 00002800
* DSN8SSH3 * 00002900
* DSN8SSH4 * 00003000
* DSN8SSH5 * 00003100
* RESTRICTIONS = NONE * 00003200
* * 00003300
* MODULE TYPE = VS COBOL II PROGRAM * 00003400
* PROCESSOR = DB2 PRECOMPILER, VS COBOL II * 00003500
* MODULE SIZE = SEE LINKEDIT * 00003600
* ATTRIBUTES = NOT REENTRANT OR REUSABLE * 00003700
* * 00003800
* ENTRY POINT = DSN8HC3 * 00003900
* PURPOSE = SEE FUNCTION * 00004000
* LINKAGE = INVOKED FROM ISPF * 00004100
* * 00004200
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 00004300
* INPUT-MESSAGE: * 00004400
* * 00004500
* SYMBOLIC LABEL/NAME = DSN8SSH * 00004600
* DESCRIPTION = MAIN MENU * 00004700
* * 00004800
* SYMBOLIC LABEL/NAME = DSN8SSH2 * 00004900
* DESCRIPTION = DEPARTMENT PANEL * 00005000
* * 00005100
* SYMBOLIC LABEL/NAME = DSN8SSH3 * 00005200
* DESCRIPTION = SELECT FROM LIST PANEL * 00005300
* * 00005400
* SYMBOLIC LABEL/NAME = DSN8SSH4 * 00005500
* DESCRIPTION = SELECT FROM LIST PANEL * 00005600
* * 00005700
* SYMBOLIC LABEL/NAME = DSN8SSH5 * 00005800
* DESCRIPTION = EMPLOYEE PANEL * 00005900
* * 00006000
* SYMBOLIC LABEL/NAME = VHDEPT * 00006100
* DESCRIPTION = VIEW OF DEPARTMENT DATA * 00006200
* * 00006300
* SYMBOLIC LABEL/NAME = VEMP * 00006400
* DESCRIPTION = VIEW OF EMPLOYEE DATA * 00006500
* * 00006600
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00006700
* OUTPUT-MESSAGE: * 00006800
* * 00006900
* SYMBOLIC LABEL/NAME = DSN8SSH * 00007000
* DESCRIPTION = MAIN MENU PANEL * 00007100
* * 00007200
* SYMBOLIC LABEL/NAME = DSN8SSH1 * 00007300
* DESCRIPTION = DEPARTMENT STRUCTURE PANEL * 00007400
* * 00007500
* SYMBOLIC LABEL/NAME = DSN8SSH2 * 00007600
* DESCRIPTION = DEPARTMENT PANEL * 00007700
* * 00007800
* SYMBOLIC LABEL/NAME = DSN8SSH3 * 00007900
* DESCRIPTION = SELECTION LIST PANEL * 00008000
* * 00008100
* SYMBOLIC LABEL/NAME = DSN8SSH4 * 00008200
* DESCRIPTION = SELECTION LIST PANEL * 00008300
* * 00008400
* SYMBOLIC LABEL/NAME = DSN8SSH5 * 00008500
* DESCRIPTION = EMPLOYEE PANEL * 00008600
* * 00008700
* EXIT-NORMAL = RETURN CODE 0 NORMAL COMPLETION * 00008800
* * 00008900
* EXIT-ERROR = * 00009000
* * 00009100
* RETURN CODE = NONE * 00009200
* * 00009300
* ABEND CODES = NONE * 00009400
* * 00009500
* * 00009600
* ERROR-MESSAGES = * 00009700
* DSN8001I - EMPLOYEE NOT FOUND * 00009800
* DSN8002I - EMPLOYEE SUCCESSFULLY ADDED * 00009900
* DSN8003I - EMPLOYEE SUCCESSFULLY ERASED * 00010000
* DSN8004I - EMPLOYEE SUCCESSFULLY UPDATED * 00010100
* DSN8005E - EMPLOYEE EXISTS ALREADY, ADD NOT DONE * 00010200
* DSN8006E - EMPLOYEE DOES NOT EXIST, ERASE NOT DONE * 00010300
* DSN8007E - EMPLOYEE DOES NOT EXIST, UPDATE NOT DONE* 00010400
* DSN8011I - DEPARTMENT NOT FOUND * 00010500
* DSN8012I - DEPARTMENT SUCCESSFULLY ADDED * 00010600
* DSN8013I - DEPARTMENT SUCCESSFULLY ERASED * 00010700
* DSN8014I - DEPARTMENT SUCCESSFULLY UPDATED * 00010800
* DSN8015E - DEPARTMENT EXISTS ALREADY, ADD NOT DONE * 00010900
* DSN8016E - DEPARTMENT DOES NOT EXIST, ERASE NOT * 00011000
* DONE * 00011100
* DSN8017E - DEPARTMENT DOES NOT EXIST, UPDATE NOT * 00011200
* DONE * 00011300
* DSN8060E - SQL ERROR, RETURN CODE IS: * 00011400
* DSN8074E - DATA IS TOO LONG FOR SEARCH CRITERIA * 00011500
* DSN8079E - CONNECTION NOT ESTABLISHED * 00011600
* DSN8200E - INVALID DEPARTMENT NUMBER, EMPLOYEE NOT * 00011700
* ADDED * 00011800
* DSN8203E - INVALID WORK DEPT, EMPLOYEE NOT UPDATED * 00011900
* DSN8210E - INVALID MGRNO, DEPARTMENT NOT ADDED * 00012000
* DSN8213E - INVALID ADMIN DEPT ID, DEPARTMENT NOT * 00012100
* ADDED * 00012200
* DSN8214E - INVALID MANAGER ID, DEPARTMENT NOT * 00012300
* UPDATED * 00012400
* DSN8215E - INVALID ADMIN DEPT ID, DEPARTMENT NOT * 00012500
* UPDATED * 00012600
* DSN8216E - DEPT NOT AT SPECIFIED LOCATION, EMPLOYEE* 00012700
* NOT ADDED * 00012800
* DSN8217E - DEPT NOT AT SPECIFIED LOCATION, EMP NOT * 00012900
* UPDATED * 00013000
* * 00013100
* EXTERNAL REFERENCES = * 00013200
* ROUTINES/SERVICES = * 00013300
* DSN8MCG - ERROR MESSAGE ROUTINE * 00013400
* ISPLINK - ISPF SERVICES ROUTINE * 00013500
* * 00013600
* DATA-AREAS = * 00013700
* NONE * 00013800
* * 00013900
* CONTROL-BLOCKS = * 00014000
* SQLCA - SQL COMMUNICATION AREA * 00014100
* * 00014200
* TABLES = NONE * 00014300
* * 00014400
* * 00014500
* CHANGE-ACTIVITY = NONE * 00014600
* * 00014700
* *PSEUDOCODE* * 00014800
* * 00014900
* SET UP RETURN CODE HANDLING 0000-PROGRAM-START* 00015000
* SET PREVIOUS LOCATION TO LOCAL * 00015100
* DO UNTIL NO MORE TERMINAL INPUT * 00015200
* GET PANEL INPUT 1000-MAIN-LOOP * 00015300
* IF CURRENT AND PREVIOUS LOCATION DIFFER THEN * 00015400
* IF REMOTE LOCATION THEN * 00015500
* CONNECT TO REMOTE LOCATION * 00015600
* ELSE RESET TO LOCAL LOCATION * 00015700
* DETERMINE PROCESSING REQUEST * 00015800
* IF ACTION FIELD ADD: * 00015900
* IF OBJECT FIELD IS DE: * 00016000
* ADD RECORD TO VHDEPT TABLES 2000-ADDDEPT * 00016100
* AT ALL LOCATIONS * 00016200
* ELSE IF OBJECT FIELD IS EM: * 00016300
* ADD RECORD TO VEMP TABLE 3000-ADDEMP * 00016400
* ELSE: * 00016500
* ELSE: * 00016600
* IF OBJECT FIELD DE OR DS: 5000-DEPARTMENT * 00016700
* IF "LIST GENERIC": 5100-GENDEPT * 00016800
* CHOOSE CURSOR BASED ON 5110-GETDEPTTAB * 00016900
* SEARCH CRITERIA AND DATA * 00017000
* CREATE ISPF TABLE * 00017100
* DO UNTIL NO MORE RECORDS: * 00017200
* FETCH RECORD * 00017300
* STORE RECORD IN TABLE * 00017400
* DISPLAY DEPARTMENT LIST 5121-GETDEPT * 00017500
* ON SCREEN * 00017600
* STORE SELECTED DEPT ID IN * 00017700
* HOST VARIABLE * 00017800
* ELSE: * 00017900
* IF OBJFLD IS DE: 5200-DISPLAYDEPT * 00018000
* FETCH SELECTED DEPT * 00018100
* DISPLAY DEPT ON SCREEN 5210-DISDEPTACT * 00018200
* IF ACTION IS ERASE: 5220-ERASEDEPT * 00018300
* DELETE DEPARTMENT AT 5221-DELDEPTS * 00018400
* ALL LOCATIONS * 00018500
* PERFORM CASCADE DELETE 5223-DELDEPEND * 00018600
* OF DEPENDENT DEPTS * 00018700
* AT ALL LOCATIONS * 00018800
* ELSE IF ACTION IS UPDATE: 5230-UPDATEDEPT * 00018900
* UPDATE DEPARTMENT AT * 00019000
* ALL LOCATIONS * 00019100
* ELSE: * 00019200
* ELSE (OBJFLD IS DS): 5300-STRUCTURE * 00019300
* FETCH SELECTED DEPT * 00019400
* DISPLAY SELECTED DEPT * 00019500
* CREATE ISPF TABLE 5310-DISSTR * 00019600
* DO UNTIL NO MORE RECORDS: 5312-GETSTRTAB * 00019700
* FETCH DEPT REPORTING TO * 00019800
* SELECTED DEPT * 00019900
* STORE RECORD IN TABLE * 00020000
* DISPLAY DEPT LIST ON SCREEN * 00020100
* ELSE (OBJFLD IS EM): 6000-EMPLOYEE * 00020200
* IF "LIST GENERIC": 6100-GENEMP * 00020300
* CHOOSE CURSOR BASED ON 6110-GETEMPTAB * 00020400
* SEARCH CRITERIA AND DATA * 00020500
* CREATE ISPF TABLE * 00020600
* DO UNTIL NO MORE RECORDS: * 00020700
* FETCH RECORD * 00020800
* STORE RECORD IN TABLE * 00020900
* DISPLAY DEPARTMENT LIST 6121-GETEMP * 00021000
* ON SCREEN * 00021100
* STORE SELECTED DEPT ID IN * 00021200
* HOST VARIABLE * 00021300
* ELSE: * 00021400
* FETCH SELECTED EMPLOYEE 6200-DISPLAYEMP * 00021500
* DISPLAY EMPLOYEE ON SCREEN * 00021600
* IF ACTION IS ERASE: 6220-ERASEEMP * 00021700
* DELETE EMPLOYEE FROM VEMP * 00021800
* ELSE IF ACTION IS UPDATE: 6230-UPDATEEMP * 00021900
* UPDATE EMPLOYEE IN VEMP * 00022000
* END-DO UNTIL NO MORE TERMINAL INPUT * 00022100
* RELEASE ALL CONNECTIONS * 00022200
*---------------------------------------------------------------* 00022300
ENVIRONMENT DIVISION. 00022400
*------------------------ 00022500
INPUT-OUTPUT SECTION. 00022600
FILE-CONTROL. 00022700
SELECT MSGOUT ASSIGN TO UT-S-SYSPRINT. 00022800
00022900
DATA DIVISION. 00023000
*------------------------ 00023100
FILE SECTION. 00023200
00023300
FD MSGOUT 00023400
RECORD CONTAINS 71 CHARACTERS 00023500
LABEL RECORDS ARE OMITTED. 00023600
01 MSGREC PIC X(71). 00023700
00023800
WORKING-STORAGE SECTION. 00023900
*---------------------------------------------------------------* 00024000
77 COIBM PIC X(54) VALUE IS 00024100
'COPYRIGHT = 5665-DB2 (C) COPYRIGHT IBM CORP 1982, 1990'. 00024200
77 MODULE PIC X(07) VALUE 'DSN8HC3'. 00024300
77 MSGS-VAR PIC X(08) VALUE 'DSN8MSGS'. 00024400
77 MSGCODE PIC X(06). 00024500
77 SEL-EXIT PIC X(01). 00024600
77 GEND-EXIT PIC X(01). 00024700
77 GENE-EXIT PIC X(01). 00024800
77 SPECIAL-EXIT PIC X(01). 00024900
77 ROWS-CHANGED PIC 9(04). 00025000
77 NUMROWS PIC 9(08). 00025100
77 PERCENT-COUNTER PIC S9(04) COMP. 00025200
77 LENGTH-COUNTER PIC S9(04) COMP. 00025300
77 W-BLANK PIC X(01) VALUE ' '. 00025400
*--------------------------------------------------------------* 00025500
* ISPF DIALOG VARIABLE NAMES * 00025600
*--------------------------------------------------------------* 00025700
EXEC SQL INCLUDE SQLCA END-EXEC. 00025800
01 LIST-PANEL-VARS. 00025900
03 CH-VAR PIC X(08) VALUE 'ZTDSELS '. 00026000
03 QROWS PIC X(08) VALUE 'QROWS '. 00026100
* 00026200
* ACTION PANEL VARIABLES 00026300
* 00026400
03 ACT-VAR PIC X(08) VALUE 'A '. 00026500
03 OBJ-VAR PIC X(08) VALUE 'OB '. 00026600
03 SEA-VAR PIC X(08) VALUE 'SE '. 00026700
03 LOC-VAR PIC X(08) VALUE 'LOCATION'. 00026800
03 DAT-VAR PIC X(08) VALUE 'NAMEID '. 00026900
* 00027000
* DEPARTMENT STRUCTURE VARIABLES 00027100
* 00027200
03 DN1M-VAR PIC X(08) VALUE 'MDEPIDP '. 00027300
03 DNAME1M-VAR PIC X(08) VALUE 'MDEPNAMP'. 00027400
03 DMGR1M-VAR PIC X(08) VALUE 'MMGRIDP '. 00027500
03 EFN1M-VAR PIC X(08) VALUE 'MMGNAMP '. 00027600
03 EMI1M-VAR PIC X(08) VALUE 'MMGMIP '. 00027700
03 ELN1M-VAR PIC X(08) VALUE 'MMGLNMP '. 00027800
03 DN1-VAR PIC X(08) VALUE 'DEPIDP '. 00027900
03 DNAME1-VAR PIC X(08) VALUE 'DEPNAMP '. 00028000
03 DMGR1-VAR PIC X(08) VALUE 'MGRIDP '. 00028100
03 EFN1-VAR PIC X(08) VALUE 'MGNAMP '. 00028200
03 EMI1-VAR PIC X(08) VALUE 'MGMIP '. 00028300
03 ELN1-VAR PIC X(08) VALUE 'MGLNMP '. 00028400
* 00028500
* DISPLAY PANEL VARIABLES 00028600
* 00028700
03 ACTL-VAR PIC X(08) VALUE 'PACTION '. 00028800
03 DN2-VAR PIC X(08) VALUE 'DEPID2 '. 00028900
03 DNAME2-VAR PIC X(08) VALUE 'DEPNAM2 '. 00029000
03 DMGR2-VAR PIC X(08) VALUE 'MGRID2 '. 00029100
03 DADM-VAR PIC X(08) VALUE 'MDEPID2 '. 00029200
03 DLOC-VAR PIC X(08) VALUE 'DEPLOC2 '. 00029300
03 EN2-VAR PIC X(08) VALUE 'EMPID2 '. 00029400
03 EFN2-VAR PIC X(08) VALUE 'EMPNAM2 '. 00029500
03 EMI2-VAR PIC X(08) VALUE 'EMPMI2 '. 00029600
03 ELN2-VAR PIC X(08) VALUE 'MLNM2 '. 00029700
03 EWD-VAR PIC X(08) VALUE 'DEPIDB2 '. 00029800
* 00029900
* SELECT DEPARTMENT VARIABLES 00030000
* 00030100
03 SD-VAR PIC X(08) VALUE 'SELECT '. 00030200
03 DN3-VAR PIC X(08) VALUE 'DID '. 00030300
03 DNAME3-VAR PIC X(08) VALUE 'DEPNGEN '. 00030400
03 DMGR3-VAR PIC X(08) VALUE 'MID '. 00030500
03 MGRN-VAR PIC X(08) VALUE 'MNGEN '. 00030600
* 00030700
* SELECT EMPLOYEE VARIABLES 00030800
* 00030900
03 SEM-VAR PIC X(08) VALUE 'SELEC4 '. 00031000
03 EN4-VAR PIC X(08) VALUE 'EMPID4 '. 00031100
03 EMPN-VAR PIC X(08) VALUE 'EMPNM4 '. 00031200
03 DN4-VAR PIC X(08) VALUE 'DEPID4 '. 00031300
03 DNAME4-VAR PIC X(08) VALUE 'DPNAME4 '. 00031400
* 00031500
* TABLE VARIABLES 00031600
* 00031700
03 DEPT-TABLE PIC X(08) VALUE 'DSN8DTAB'. 00031800
03 DS-TABLE PIC X(08) VALUE 'DSN8STAB'. 00031900
03 EMP-TABLE PIC X(08) VALUE 'DSN8ESEL'. 00032000
* 00032100
* VARIABLE LISTS 00032200
* 00032300
03 ACTION-VARS PIC X(27) VALUE IS 00032400
'( A OB SE LOCATION NAMEID )'. 00032500
03 IDEN-VAR PIC X(19) VALUE IS 00032600
'( PACTION )'. 00032700
03 ADD-DEPT-VARS PIC X(40) VALUE IS 00032800
'( DEPID2 DEPNAM2 MGRID2 MDEPID2 DEPLOC2)'. 00032900
03 DEPT-VARS PIC X(77) VALUE IS 00033000
'( DEPID2 DEPNAM2 MGRID2 MDEPID2 DEPLOC2 EMPID2 EMPNAM2 EMPMI00033100
- '2 MLNM2 DEPIDB2 )'. 00033200
03 ADD-EMP-VARS PIC X(39) VALUE IS 00033300
'( EMPID2 EMPNAM2 EMPMI2 MLNM2 DEPIDB2 )'. 00033400
03 SEL-EMP-VARS PIC X(47) VALUE IS 00033500
'( ZTDSELS SELEC4 EMPID4 EMPNM4 DEPID4 DPNAME4 )'. 00033600
03 SEL-DEPT-VARS PIC X(40) VALUE IS 00033700
'( ZTDSELS SELECT DID DEPNGEN MID MNGEN )'. 00033800
03 HEAD-DEPT-VARS PIC X(51) VALUE IS 00033900
'( MDEPIDP MDEPNAMP MMGRIDP MMGNAMP MMGMIP MMGLNMP )'. 00034000
03 DS-VARS PIC X(45) VALUE IS 00034100
'( DEPIDP DEPNAMP MGRIDP MGNAMP MGMIP MGLNMP )'. 00034200
01 PANEL-VARIABLE-LENGTHS. 00034300
03 CH-VAR-STG PIC 9(06) COMP VALUE 04. 00034400
03 QROWS-STG PIC 9(06) COMP VALUE 08. 00034500
* 00034600
* ACTION PANEL VARIABLES 00034700
* 00034800
03 AC-VAR-STG PIC 9(06) COMP VALUE 01. 00034900
03 OB-VAR-STG PIC 9(06) COMP VALUE 02. 00035000
03 SE-VAR-STG PIC 9(06) COMP VALUE 02. 00035100
03 LO-VAR-STG PIC 9(06) COMP VALUE 16. 00035200
03 DT-VAR-STG PIC 9(06) COMP VALUE 36. 00035300
* 00035400
* DEPARTMENT STRUCTURE VARIABLES 00035500
* 00035600
03 DN1M-VAR-STG PIC 9(06) COMP VALUE 03. 00035700
03 DNAME1M-VAR-STG PIC 9(06) COMP VALUE 36. 00035800
03 DMGR1M-VAR-STG PIC 9(06) COMP VALUE 06. 00035900
03 EFN1M-VAR-STG PIC 9(06) COMP VALUE 12. 00036000
03 EMI1M-VAR-STG PIC 9(06) COMP VALUE 01. 00036100
03 ELN1M-VAR-STG PIC 9(06) COMP VALUE 15. 00036200
03 DN1-VAR-STG PIC 9(06) COMP VALUE 03. 00036300
03 DNAME1-VAR-STG PIC 9(06) COMP VALUE 36. 00036400
03 DMGR1-VAR-STG PIC 9(06) COMP VALUE 06. 00036500
03 EFN1-VAR-STG PIC 9(06) COMP VALUE 12. 00036600
03 EMI1-VAR-STG PIC 9(06) COMP VALUE 01. 00036700
03 ELN1-VAR-STG PIC 9(06) COMP VALUE 15. 00036800
* 00036900
* DISPLAY PANEL VARIABLES 00037000
* 00037100
03 ACL-VAR-STG PIC 9(06) COMP VALUE 07. 00037200
03 OCL-VAR-STG PIC 9(06) COMP VALUE 10. 00037300
03 DN2-VAR-STG PIC 9(06) COMP VALUE 03. 00037400
03 DNAME2-VAR-STG PIC 9(06) COMP VALUE 36. 00037500
03 DMGR2-VAR-STG PIC 9(06) COMP VALUE 06. 00037600
03 DADM-VAR-STG PIC 9(06) COMP VALUE 03. 00037700
03 DLOC-VAR-STG PIC 9(06) COMP VALUE 16. 00037800
03 EN2-VAR-STG PIC 9(06) COMP VALUE 06. 00037900
03 EFN2-VAR-STG PIC 9(06) COMP VALUE 12. 00038000
03 EMI2-VAR-STG PIC 9(06) COMP VALUE 01. 00038100
03 ELN2-VAR-STG PIC 9(06) COMP VALUE 15. 00038200
03 EWD-VAR-STG PIC 9(06) COMP VALUE 03. 00038300
* 00038400
* SELECT DEPARTMENT VARIABLES 00038500
* 00038600
03 SD-VAR-STG PIC 9(06) COMP VALUE 01. 00038700
03 DN3-VAR-STG PIC 9(06) COMP VALUE 03. 00038800
03 DNAME3-VAR-STG PIC 9(06) COMP VALUE 36. 00038900
03 DMGR3-VAR-STG PIC 9(06) COMP VALUE 06. 00039000
03 MGRN-VAR-STG PIC 9(06) COMP VALUE 18. 00039100
* 00039200
* SELECT EMPLOYEE VARIABLES 00039300
* 00039400
03 SEM-VAR-STG PIC 9(06) COMP VALUE 01. 00039500
03 EN4-VAR-STG PIC 9(06) COMP VALUE 06. 00039600
03 EMPN-VAR-STG PIC 9(06) COMP VALUE 17. 00039700
03 DN4-VAR-STG PIC 9(06) COMP VALUE 03. 00039800
03 DNAME4-VAR-STG PIC 9(06) COMP VALUE 36. 00039900
* 00040000
03 MSGS-VAR-STG PIC 9(06) COMP VALUE 79. 00040100
*---------------------------------------------------------------* 00040200
* ISPF DIALOG SERVICES DECLARATIONS * 00040300
*---------------------------------------------------------------* 00040400
01 I-VDEFINE PIC X(08) VALUE 'VDEFINE '. 00040500
01 I-VGET PIC X(08) VALUE 'VGET '. 00040600
01 I-VPUT PIC X(08) VALUE 'VPUT '. 00040700
01 I-DISPLAY PIC X(08) VALUE 'DISPLAY '. 00040800
01 I-TBDISPL PIC X(08) VALUE 'TBDISPL '. 00040900
01 I-TBTOP PIC X(08) VALUE 'TBTOP '. 00041000
01 I-TBCREATE PIC X(08) VALUE 'TBCREATE'. 00041100
01 I-TBCLOSE PIC X(08) VALUE 'TBCLOSE '. 00041200
01 I-TBADD PIC X(08) VALUE 'TBADD '. 00041300
01 I-TBGET PIC X(08) VALUE 'TBGET '. 00041400
01 I-TBQUERY PIC X(08) VALUE 'TBQUERY '. 00041500
*---------------------------------------------------------------* 00041600
* ISPF CALL MODIFIERS * 00041700
*---------------------------------------------------------------* 00041800
01 I-NOWRITE PIC X(08) VALUE 'NOWRITE '. 00041900
01 I-REPLACE PIC X(08) VALUE 'REPLACE '. 00042000
01 I-CHAR PIC X(08) VALUE 'CHAR '. 00042100
*---------------------------------------------------------------* 00042200
* ISPF PANEL NAMES * 00042300
*---------------------------------------------------------------* 00042400
01 SEL-PANEL PIC X(08) VALUE 'DSN8SSH '. 00042500
01 STR-PANEL PIC X(08) VALUE 'DSN8SSH1'. 00042600
01 DEPT-PANEL PIC X(08) VALUE 'DSN8SSH2'. 00042700
01 GEND-PANEL PIC X(08) VALUE 'DSN8SSH3'. 00042800
01 GENE-PANEL PIC X(08) VALUE 'DSN8SSH4'. 00042900
01 EMP-PANEL PIC X(08) VALUE 'DSN8SSH5'. 00043000
*---------------------------------------------------------------* 00043100
* LOCAL-VARIABLES * 00043200
*---------------------------------------------------------------* 00043300
01 LOCAL-VARIABLES. 00043400
03 DATAW PIC X(36). 00043500
03 GENDATA PIC X(36). 00043600
03 SEL-DEPT PIC X(01). 00043700
03 SEL-EMP PIC X(01). 00043800
03 MGR-NAME PIC X(18). 00043900
03 EMP-NAME PIC X(17). 00044000
03 TOKEN PIC X(70). 00044100
03 TEMPLOC PIC X(16). 00044200
03 PREVLOC PIC X(16). 00044300
03 TEMPDEPT PIC X(03). 00044400
03 CURDEPT PIC X(03). 00044500
03 DELDEPT PIC X(03). 00044600
03 STACKTOP PIC S9(04). 00044700
03 DEPTPTR PIC S9(04). 00044800
03 LISTPTR PIC S9(04). 00044900
03 LOCPTR PIC S9(04). 00045000
03 LOCTOP PIC S9(04). 00045100
03 CONVSQL PIC S9(15) COMP-3. 00045200
03 OUTMSG PIC X(69). 00045300
03 TMSG REDEFINES OUTMSG. 00045400
05 TMSGTXT PIC X(46). 00045500
05 FILLER PIC X(23). 00045600
03 MSGS PIC X(79) VALUE SPACES. 00045700
03 MSGS-DETAIL REDEFINES MSGS. 00045800
05 OUT-MESSAGE PIC X(46). 00045900
05 SQL-CODE PIC +(04). 00046000
05 FILLER PIC X(29). 00046100
00046200
01 CONV PIC S9(15) COMP-3. 00046300
01 DEPTS-TABLE. 00046400
03 DEPTS OCCURS 1000 TIMES. 00046500
05 DEPTS-ITEM PIC X(03). 00046600
01 DEPTLIST-TABLE. 00046700
03 DEPTLIST OCCURS 1000 TIMES. 00046800
05 DEPTLIST-ITEM PIC X(03). 00046900
01 LOCLIST-TABLE. 00047000
03 LOCLIST OCCURS 1000 TIMES. 00047100
05 LOCLIST-ITEM PIC X(16). 00047200
*---------------------------------------------------------------* 00047300
* ACTION PANEL - IO AREA * 00047400
*---------------------------------------------------------------* 00047500
01 PGM-PANEL-VARS. 00047600
03 ACTION PIC X(01). 00047700
03 OBJFLD PIC X(02). 00047800
03 SEARCH-CRIT PIC X(02). 00047900
03 LOCATION PIC X(16). 00048000
03 NAMEID PIC X(36). 00048100
03 ACTION-LIST PIC X(07). 00048200
*---------------------------------------------------------------* 00048300
* EMPLOYEE RECORD - IO AREA * 00048400
*---------------------------------------------------------------* 00048500
01 EMP-RECORD. 00048600
02 EMP-NUMB PIC X(06). 00048700
02 EMP-FIRST-NAME PIC X(12). 00048800
02 EMP-MID-INIT PIC X(01). 00048900
02 EMP-LAST-NAME PIC X(15). 00049000
02 EMP-WORK-DEPT PIC X(03). 00049100
01 EMP-INDICATOR-TABLE. 00049200
02 WORK-DEPT-IND PIC S9(4) COMP. 00049300
*---------------------------------------------------------------* 00049400
* EMPLOYEE RECORD FOR DEPT STRUCTURE - IO AREA * 00049500
*---------------------------------------------------------------* 00049600
01 EMP1-RECORD. 00049700
02 EMP1-NUMB PIC X(06). 00049800
02 EMP1-FIRST-NAME PIC X(12). 00049900
02 EMP1-MID-INIT PIC X(01). 00050000
02 EMP1-LAST-NAME PIC X(15). 00050100
02 EMP1-WORK-DEPT PIC X(03). 00050200
01 EMP1-INDICATOR-TABLE. 00050300
02 WORK1-DEPT-IND PIC S9(4) COMP. 00050400
*---------------------------------------------------------------* 00050500
* DEPARTMENT RECORD - IO AREA * 00050600
*---------------------------------------------------------------* 00050700
01 DEPT-RECORD. 00050800
02 DEPT-NUMB PIC X(03). 00050900
02 DEPT-NAME PIC X(36). 00051000
02 DEPT-MGR PIC X(06). 00051100
02 DEPT-ADMR PIC X(03). 00051200
02 DEPT-LOC PIC X(16). 00051300
01 DEPT-INDICATOR-TABLE. 00051400
02 DEPT-MGR-IND PIC S9(4) COMP. 00051500
*---------------------------------------------------------------* 00051600
* DEPARTMENT RECORD FOR DEPT STRUCTURE - IO AREA * 00051700
*---------------------------------------------------------------* 00051800
01 DEPT1-RECORD. 00051900
02 DEPT1-NUMB PIC X(03). 00052000
02 DEPT1-NAME PIC X(36). 00052100
02 DEPT1-MGR PIC X(06). 00052200
02 DEPT1-ADMR PIC X(03). 00052300
02 DEPT1-LOC PIC X(16). 00052400
01 DEPT1-INDICATOR-TABLE. 00052500
02 DEPT1-MGR-IND PIC S9(4) COMP. 00052600
*---------------------------------------------------------------* 00052700
* SQLCA OUTPUT * 00052800
*---------------------------------------------------------------* 00052900
00053000
01 SQLCA-LINE0. 00053100
02 FILLER PIC X(45) VALUE 00053200
'DSN8060E DSN8HC3 SQL ERROR, RETURN CODE IS: '. 00053300
02 SQLCODE-MSG PIC +(16). 00053400
02 FILLER PIC X(11) VALUE SPACES. 00053500
00053600
01 SQLCA-LINE1. 00053700
02 FILLER PIC X(05) VALUE SPACES. 00053800
02 SQLCAID-NAME PIC X(13) VALUE 'SQLCAID = '. 00053900
02 SQLCAID-VALUE PIC X(08). 00054000
02 FILLER PIC X(14) VALUE SPACES. 00054100
02 SQLCABC-NAME PIC X(13) VALUE 'SQLABC = '. 00054200
02 SQLCABC-VALUE PIC Z(15). 00054300
02 FILLER PIC X(03) VALUE SPACES. 00054400
00054500
01 SQLCA-LINE2. 00054600
02 FILLER PIC X(05) VALUE SPACES. 00054700
02 SQLCODE-NAME PIC X(13) VALUE 'SQLCODE = '. 00054800
02 SQLCODE-VALUE PIC +(16). 00054900
02 FILLER PIC X(07) VALUE SPACES. 00055000
02 SQLERRML-NAME PIC X(13) VALUE 'SQLERRML = '. 00055100
02 SQLERRML-VALUE PIC Z(15). 00055200
02 FILLER PIC X(03) VALUE SPACES. 00055300
00055400
01 SQLCA-LINE3. 00055500
02 FILLER PIC X(05) VALUE SPACES. 00055600
02 SQLERRMC-NAME PIC X(13) VALUE 'SQLERRMC = '. 00055700
02 FILLER PIC X(53) VALUE SPACES. 00055800
00055900
01 SQLCA-LINE4. 00056000
02 FILLER PIC X(01) VALUE SPACES. 00056100
02 SQLERRMC-VALUE PIC X(70). 00056200
00056300
01 SQLCA-LINE5. 00056400
02 FILLER PIC X(05) VALUE SPACES. 00056500
02 SQLERRP-NAME PIC X(13) VALUE 'SQLERRP = '. 00056600
02 SQLERRP-VALUE PIC X(08). 00056700
02 FILLER PIC X(14) VALUE SPACES. 00056800
02 SQLERRD1-NAME PIC X(13) VALUE 'SQLERRD(1) = '. 00056900
02 SQLERRD1-VALUE PIC Z(14)9. 00057000
02 FILLER PIC X(03) VALUE SPACES. 00057100
00057200
01 SQLCA-LINE6. 00057300
02 FILLER PIC X(05) VALUE SPACES. 00057400
02 SQLERRD2-NAME PIC X(13) VALUE 'SQLERRD(2) = '. 00057500
02 SQLERRD2-VALUE PIC Z(14)9. 00057600
02 FILLER PIC X(07) VALUE SPACES. 00057700
02 SQLERRD3-NAME PIC X(13) VALUE 'SQLERRD(3) = '. 00057800
02 SQLERRD3-VALUE PIC Z(14)9. 00057900
02 FILLER PIC X(03) VALUE SPACES. 00058000
00058100
01 SQLCA-LINE7. 00058200
02 FILLER PIC X(05) VALUE SPACES. 00058300
02 SQLERRD4-NAME PIC X(13) VALUE 'SQLERRD(4) = '. 00058400
02 SQLERRD4-VALUE PIC Z(14)9. 00058500
02 FILLER PIC X(07) VALUE SPACES. 00058600
02 SQLERRD5-NAME PIC X(13) VALUE 'SQLERRD(5) = '. 00058700
02 SQLERRD5-VALUE PIC Z(14)9. 00058800
02 FILLER PIC X(03) VALUE SPACES. 00058900
00059000
01 SQLCA-LINE8. 00059100
02 FILLER PIC X(05) VALUE SPACES. 00059200
02 SQLERRD6-NAME PIC X(13) VALUE 'SQLERRD(6) = '. 00059300
02 SQLERRD6-VALUE PIC Z(14)9. 00059400
02 FILLER PIC X(07) VALUE SPACES. 00059500
02 SQLWARN0-NAME PIC X(13) VALUE 'SQLWARN0 = '. 00059600
02 SQLWARN0-VALUE PIC X. 00059700
02 FILLER PIC X(17) VALUE SPACES. 00059800
00059900
01 SQLCA-LINE9. 00060000
02 FILLER PIC X(05) VALUE SPACES. 00060100
02 SQLWARN1-NAME PIC X(13) VALUE 'SQLWARN1 = '. 00060200
02 SQLWARN1-VALUE PIC X. 00060300
02 FILLER PIC X(21) VALUE SPACES. 00060400
02 SQLWARN2-NAME PIC X(13) VALUE 'SQLWARN2 = '. 00060500
02 SQLWARN2-VALUE PIC X. 00060600
02 FILLER PIC X(17) VALUE SPACES. 00060700
00060800
01 SQLCA-LINE10. 00060900
02 FILLER PIC X(05) VALUE SPACES. 00061000
02 SQLWARN3-NAME PIC X(13) VALUE 'SQLWARN3 = '. 00061100
02 SQLWARN3-VALUE PIC X. 00061200
02 FILLER PIC X(21) VALUE SPACES. 00061300
02 SQLWARN4-NAME PIC X(13) VALUE 'SQLWARN4 = '. 00061400
02 SQLWARN4-VALUE PIC X. 00061500
02 FILLER PIC X(17) VALUE SPACES. 00061600
00061700
01 SQLCA-LINE11. 00061800
02 FILLER PIC X(05) VALUE SPACES. 00061900
02 SQLWARN5-NAME PIC X(13) VALUE 'SQLWARN5 = '. 00062000
02 SQLWARN5-VALUE PIC X. 00062100
02 FILLER PIC X(21) VALUE SPACES. 00062200
02 SQLWARN6-NAME PIC X(13) VALUE 'SQLWARN6 = '. 00062300
02 SQLWARN6-VALUE PIC X. 00062400
02 FILLER PIC X(17) VALUE SPACES. 00062500
00062600
01 SQLCA-LINE12. 00062700
02 FILLER PIC X(05) VALUE SPACES. 00062800
02 SQLWARN7-NAME PIC X(13) VALUE 'SQLWARN7 = '. 00062900
02 SQLWARN7-VALUE PIC X. 00063000
02 FILLER PIC X(21) VALUE SPACES. 00063100
02 SQLWARN8-NAME PIC X(13) VALUE 'SQLWARN8 = '. 00063200
02 SQLWARN8-VALUE PIC X. 00063300
02 FILLER PIC X(17) VALUE SPACES. 00063400
00063500
01 SQLCA-LINE13. 00063600
02 FILLER PIC X(05) VALUE SPACES. 00063700
02 SQLWARN9-NAME PIC X(13) VALUE 'SQLWARN9 = '. 00063800
02 SQLWARN9-VALUE PIC X. 00063900
02 FILLER PIC X(21) VALUE SPACES. 00064000
02 SQLWARNA-NAME PIC X(13) VALUE 'SQLWARNA = '. 00064100
02 SQLWARNA-VALUE PIC X. 00064200
02 FILLER PIC X(17) VALUE SPACES. 00064300
00064400
01 SQLCA-LINE14. 00064500
02 FILLER PIC X(05) VALUE SPACES. 00064600
02 SQLSTATE-NAME PIC X(13) VALUE 'SQLSTATE = '. 00064700
02 SQLSTATE-VALUE PIC X(05). 00064800
02 FILLER PIC X(48) VALUE SPACES. 00064900
00065000
**************************************************************** 00065100
* LINKAGE SECTION * 00065200
**************************************************************** 00065300
00065400
LINKAGE SECTION. 00065500
00065600
*---------------------------------------------------------------* 00065700
* SQL DECLARATION FOR VIEW VHDEPT * 00065800
*---------------------------------------------------------------* 00065900
EXEC SQL DECLARE VHDEPT TABLE 00066000
(DEPTNO CHAR(3) NOT NULL, 00066100
DEPTNAME VARCHAR(36) NOT NULL, 00066200
MGRNO CHAR(6) , 00066300
ADMRDEPT CHAR(3) NOT NULL, 00066400
LOCATION CHAR(16)) END-EXEC. 00066500
*---------------------------------------------------------------* 00066600
* SQL DECLARATION FOR VIEW VEMP * 00066700
*---------------------------------------------------------------* 00066800
EXEC SQL DECLARE VEMP TABLE 00066900
(EMPNO CHAR(6) NOT NULL, 00067000
FIRSTNME VARCHAR(12) NOT NULL, 00067100
MIDINIT CHAR(1) NOT NULL, 00067200
LASTNAME VARCHAR(15) NOT NULL, 00067300
WORKDEPT CHAR(3)) END-EXEC. 00067400
*---------------------------------------------------------------* 00067500
* SQL CURSORS * 00067600
*---------------------------------------------------------------* 00067700
* 00067800
EXEC SQL DECLARE CURDEPTLOC CURSOR FOR 00067900
SELECT LOCATION 00068000
FROM VHDEPT 00068100
WHERE DEPTNO = :EMP-WORK-DEPT 00068200
AND LOCATION = CURRENT SERVER 00068300
END-EXEC. 00068400
* 00068500
EXEC SQL DECLARE DEPTLOC CURSOR FOR 00068600
SELECT LOCATION 00068700
FROM VHDEPT 00068800
WHERE DEPTNO = :EMP-WORK-DEPT 00068900
END-EXEC. 00069000
* 00069100
EXEC SQL DECLARE LOCS CURSOR FOR 00069200
SELECT DISTINCT LOCATION 00069300
FROM VHDEPT 00069400
WHERE LOCATION <> :LOCATION 00069500
AND LOCATION <> ' ' 00069600
AND LOCATION <> CURRENT SERVER 00069700
END-EXEC. 00069800
* 00069900
EXEC SQL DECLARE SUBDEPTS CURSOR FOR 00070000
SELECT DEPTNO 00070100
FROM VHDEPT 00070200
WHERE ADMRDEPT = :CURDEPT 00070300
AND DEPTNO <> :CURDEPT 00070400
END-EXEC. 00070500
* 00070600
EXEC SQL DECLARE DEPT1 CURSOR FOR 00070700
SELECT DEPTNO, DEPTNAME, MGRNO, ADMRDEPT, LOCATION, 00070800
EMPNO, FIRSTNME, MIDINIT, LASTNAME, WORKDEPT 00070900
FROM VHDEPT, VEMP 00071000
WHERE DEPTNO = :DATAW 00071100
AND MGRNO = EMPNO 00071200
UNION 00071300
SELECT DEPTNO, DEPTNAME, MGRNO, ADMRDEPT, LOCATION, 00071400
' ', ' ', ' ', ' ', ' ' 00071500
FROM VHDEPT 00071600
WHERE DEPTNO = :DATAW 00071700
AND MGRNO IS NULL 00071800
END-EXEC. 00071900
* 00072000
EXEC SQL DECLARE ALLDEPT1 CURSOR FOR 00072100
SELECT DEPTNO, DEPTNAME, MGRNO, 00072200
SUBSTR(FIRSTNME, 1, 1) || MIDINIT || ' ' || LASTNAME 00072300
FROM VHDEPT, VEMP 00072400
WHERE MGRNO = EMPNO 00072500
AND DEPTNO LIKE :GENDATA 00072600
UNION 00072700
SELECT DEPTNO, DEPTNAME, MGRNO, ' ' 00072800
FROM VHDEPT 00072900
WHERE MGRNO IS NULL 00073000
AND DEPTNO LIKE :GENDATA 00073100
ORDER BY 1 00073200
END-EXEC. 00073300
* 00073400
EXEC SQL DECLARE ALLDEPT2 CURSOR FOR 00073500
SELECT DEPTNO, DEPTNAME, MGRNO, 00073600
SUBSTR(FIRSTNME, 1, 1) || MIDINIT || ' ' || LASTNAME 00073700
FROM VHDEPT, VEMP 00073800
WHERE MGRNO = EMPNO 00073900
AND DEPTNAME LIKE :GENDATA 00074000
UNION 00074100
SELECT DEPTNO, DEPTNAME, MGRNO, ' ' 00074200
FROM VHDEPT 00074300
WHERE MGRNO IS NULL 00074400
AND DEPTNAME LIKE :GENDATA 00074500
ORDER BY 1 00074600
END-EXEC. 00074700
* 00074800
EXEC SQL DECLARE ALLDEPT3 CURSOR FOR 00074900
SELECT DEPTNO, DEPTNAME, MGRNO, 00075000
SUBSTR(FIRSTNME, 1, 1) || MIDINIT || ' ' || LASTNAME 00075100
FROM VHDEPT, VEMP 00075200
WHERE MGRNO = EMPNO 00075300
AND MGRNO LIKE :GENDATA 00075400
UNION 00075500
SELECT DEPTNO, DEPTNAME, MGRNO, ' ' 00075600
FROM VHDEPT 00075700
WHERE MGRNO IS NULL 00075800
AND MGRNO LIKE :GENDATA 00075900
ORDER BY 1 00076000
END-EXEC. 00076100
* 00076200
EXEC SQL DECLARE ALLDEPT4 CURSOR FOR 00076300
SELECT DEPTNO, DEPTNAME, MGRNO, 00076400
SUBSTR(FIRSTNME, 1, 1) || MIDINIT || ' ' || LASTNAME 00076500
FROM VHDEPT, VEMP 00076600
WHERE MGRNO = EMPNO 00076700
AND LASTNAME LIKE :GENDATA 00076800
ORDER BY 1 00076900
END-EXEC. 00077000
* 00077100
EXEC SQL DECLARE ALLDEPT5 CURSOR FOR 00077200
SELECT DEPTNO, DEPTNAME, MGRNO, 00077300
SUBSTR(FIRSTNME, 1, 1) || MIDINIT || ' ' || LASTNAME 00077400
FROM VHDEPT, VEMP 00077500
WHERE MGRNO = EMPNO 00077600
AND DEPTNAME = :GENDATA 00077700
UNION 00077800
SELECT DEPTNO, DEPTNAME, MGRNO, ' ' 00077900
FROM VHDEPT 00078000
WHERE MGRNO IS NULL 00078100
AND DEPTNAME = :GENDATA 00078200
ORDER BY 1 00078300
END-EXEC. 00078400
* 00078500
EXEC SQL DECLARE ALLDEPT6 CURSOR FOR 00078600
SELECT DEPTNO, DEPTNAME, MGRNO, 00078700
SUBSTR(FIRSTNME, 1, 1) || MIDINIT || ' ' || LASTNAME 00078800
FROM VHDEPT, VEMP 00078900
WHERE MGRNO = EMPNO 00079000
AND MGRNO = :GENDATA 00079100
UNION 00079200
SELECT DEPTNO, DEPTNAME, MGRNO, ' ' 00079300
FROM VHDEPT 00079400
WHERE MGRNO IS NULL 00079500
AND MGRNO = :GENDATA 00079600
ORDER BY 1 00079700
END-EXEC. 00079800
* 00079900
EXEC SQL DECLARE ALLDEPT7 CURSOR FOR 00080000
SELECT DEPTNO, DEPTNAME, MGRNO, 00080100
SUBSTR(FIRSTNME, 1, 1) || MIDINIT || ' ' || LASTNAME 00080200
FROM VHDEPT, VEMP 00080300
WHERE MGRNO = EMPNO 00080400
AND LASTNAME = :GENDATA 00080500
ORDER BY 1 00080600
END-EXEC. 00080700
* 00080800
EXEC SQL DECLARE EMP1 CURSOR FOR 00080900
SELECT DEPTNO, DEPTNAME, MGRNO, ADMRDEPT, LOCATION, 00081000
EMPNO, FIRSTNME, MIDINIT, LASTNAME, WORKDEPT 00081100
FROM VHDEPT, VEMP 00081200
WHERE EMPNO = :DATAW 00081300
AND WORKDEPT = DEPTNO 00081400
UNION 00081500
SELECT ' ', ' ', ' ', ' ', ' ', 00081600
EMPNO, FIRSTNME, MIDINIT, LASTNAME, ' ' 00081700
FROM VEMP 00081800
WHERE EMPNO = :DATAW 00081900
AND WORKDEPT IS NULL 00082000
END-EXEC. 00082100
* 00082200
EXEC SQL DECLARE ALLEMP1 CURSOR FOR 00082300
SELECT EMPNO, SUBSTR(FIRSTNME, 1, 1) || ' ' || LASTNAME, 00082400
WORKDEPT, DEPTNAME 00082500
FROM VHDEPT, VEMP 00082600
WHERE DEPTNO = WORKDEPT 00082700
AND EMPNO LIKE :GENDATA 00082800
UNION 00082900
SELECT EMPNO, SUBSTR(FIRSTNME, 1, 1) || ' ' || LASTNAME, 00083000
WORKDEPT, ' ' 00083100
FROM VEMP 00083200
WHERE WORKDEPT IS NULL 00083300
AND EMPNO LIKE :GENDATA 00083400
ORDER BY 1 00083500
END-EXEC. 00083600
* 00083700
EXEC SQL DECLARE ALLEMP2 CURSOR FOR 00083800
SELECT EMPNO, SUBSTR(FIRSTNME, 1, 1) || ' ' || LASTNAME, 00083900
WORKDEPT, DEPTNAME 00084000
FROM VHDEPT, VEMP 00084100
WHERE DEPTNO = WORKDEPT 00084200
AND LASTNAME LIKE :GENDATA 00084300
UNION 00084400
SELECT EMPNO, SUBSTR(FIRSTNME, 1, 1) || ' ' || LASTNAME, 00084500
WORKDEPT, ' ' 00084600
FROM VEMP 00084700
WHERE WORKDEPT IS NULL 00084800
AND LASTNAME LIKE :GENDATA 00084900
ORDER BY 1 00085000
END-EXEC. 00085100
* 00085200
EXEC SQL DECLARE ALLEMP3 CURSOR FOR 00085300
SELECT EMPNO, SUBSTR(FIRSTNME, 1, 1) || ' ' || LASTNAME, 00085400
WORKDEPT, DEPTNAME 00085500
FROM VHDEPT, VEMP 00085600
WHERE DEPTNO = WORKDEPT 00085700
AND LASTNAME = :GENDATA 00085800
UNION 00085900
SELECT EMPNO, SUBSTR(FIRSTNME, 1, 1) || ' ' || LASTNAME, 00086000
WORKDEPT, ' ' 00086100
FROM VEMP 00086200
WHERE WORKDEPT IS NULL 00086300
AND LASTNAME = :GENDATA 00086400
ORDER BY 1 00086500
END-EXEC. 00086600
* 00086700
EXEC SQL DECLARE DEPTSTR CURSOR FOR 00086800
SELECT DEPTNO, DEPTNAME, MGRNO, ADMRDEPT, LOCATION, 00086900
FIRSTNME, MIDINIT, LASTNAME 00087000
FROM VHDEPT, VEMP 00087100
WHERE ADMRDEPT = :DATAW 00087200
AND MGRNO = EMPNO 00087300
UNION 00087400
SELECT DEPTNO, DEPTNAME, MGRNO, ADMRDEPT, LOCATION, 00087500
' ', ' ', ' ' 00087600
FROM VHDEPT 00087700
WHERE ADMRDEPT = :DATAW 00087800
AND MGRNO IS NULL 00087900
ORDER BY 1 00088000
END-EXEC. 00088100
* 00088200
EJECT 00088300
PROCEDURE DIVISION. 00088400
*---------------------------------------------------------------* 00088500
* SQL RETURN CODE HANDLING * 00088600
*---------------------------------------------------------------* 00088700
EXEC SQL WHENEVER SQLERROR GOTO L8000-P3-DBERROR END-EXEC. 00088800
EXEC SQL WHENEVER SQLWARNING GOTO L8000-P3-DBERROR END-EXEC. 00088900
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC. 00089000
* 00089100
*---------------------------------------------------------------* 00089200
* DEFINE COBOL - SPF VARIABLES * 00089300
*---------------------------------------------------------------* 00089400
0000-PROGRAM-START. 00089500
CALL 'ISPLINK' USING I-VDEFINE, CH-VAR, ROWS-CHANGED, 00089600
I-CHAR, CH-VAR-STG. 00089700
CALL 'ISPLINK' USING I-VDEFINE, QROWS, NUMROWS, 00089800
I-CHAR, QROWS-STG. 00089900
* 00090000
* ACTION PANEL 00090100
* 00090200
CALL 'ISPLINK' USING I-VDEFINE, ACT-VAR, ACTION, 00090300
I-CHAR, AC-VAR-STG. 00090400
CALL 'ISPLINK' USING I-VDEFINE, OBJ-VAR, OBJFLD, 00090500
I-CHAR, OB-VAR-STG. 00090600
CALL 'ISPLINK' USING I-VDEFINE, SEA-VAR, SEARCH-CRIT, 00090700
I-CHAR, SE-VAR-STG. 00090800
CALL 'ISPLINK' USING I-VDEFINE, LOC-VAR, LOCATION, 00090900
I-CHAR, LO-VAR-STG. 00091000
CALL 'ISPLINK' USING I-VDEFINE, DAT-VAR, NAMEID, 00091100
I-CHAR, DT-VAR-STG. 00091200
* 00091300
* DEPARTMENT STRUCTURE PANEL 00091400
* 00091500
CALL 'ISPLINK' USING I-VDEFINE, DN1M-VAR, DEPT1-NUMB, 00091600
I-CHAR, DN1M-VAR-STG. 00091700
CALL 'ISPLINK' USING I-VDEFINE, DNAME1M-VAR, DEPT1-NAME, 00091800
I-CHAR, DNAME1M-VAR-STG. 00091900
CALL 'ISPLINK' USING I-VDEFINE, DMGR1M-VAR, DEPT1-MGR, 00092000
I-CHAR, DMGR1M-VAR-STG. 00092100
CALL 'ISPLINK' USING I-VDEFINE, EFN1M-VAR, EMP1-FIRST-NAME, 00092200
I-CHAR, EFN1M-VAR-STG. 00092300
CALL 'ISPLINK' USING I-VDEFINE, EMI1M-VAR, EMP1-MID-INIT, 00092400
I-CHAR, EMI1M-VAR-STG. 00092500
CALL 'ISPLINK' USING I-VDEFINE, ELN1M-VAR, EMP1-LAST-NAME, 00092600
I-CHAR, ELN1M-VAR-STG. 00092700
CALL 'ISPLINK' USING I-VDEFINE, DN1-VAR, DEPT-NUMB, 00092800
I-CHAR, DN1-VAR-STG. 00092900
CALL 'ISPLINK' USING I-VDEFINE, DNAME1-VAR, DEPT-NAME, 00093000
I-CHAR, DNAME1-VAR-STG. 00093100
CALL 'ISPLINK' USING I-VDEFINE, DMGR1-VAR, DEPT-MGR, 00093200
I-CHAR, DMGR1-VAR-STG. 00093300
CALL 'ISPLINK' USING I-VDEFINE, EFN1-VAR, EMP-FIRST-NAME, 00093400
I-CHAR, EFN1-VAR-STG. 00093500
CALL 'ISPLINK' USING I-VDEFINE, EMI1-VAR, EMP-MID-INIT, 00093600
I-CHAR, EMI1-VAR-STG. 00093700
CALL 'ISPLINK' USING I-VDEFINE, ELN1-VAR, EMP-LAST-NAME, 00093800
I-CHAR, ELN1-VAR-STG. 00093900
* 00094000
* DISPLAY PANEL 00094100
* 00094200
CALL 'ISPLINK' USING I-VDEFINE, ACTL-VAR, ACTION-LIST, 00094300
I-CHAR, ACL-VAR-STG. 00094400
CALL 'ISPLINK' USING I-VDEFINE, DN2-VAR, DEPT-NUMB, 00094500
I-CHAR, DN2-VAR-STG. 00094600
CALL 'ISPLINK' USING I-VDEFINE, DNAME2-VAR, DEPT-NAME, 00094700
I-CHAR, DNAME2-VAR-STG. 00094800
CALL 'ISPLINK' USING I-VDEFINE, DMGR2-VAR, DEPT-MGR, 00094900
I-CHAR, DMGR2-VAR-STG. 00095000
CALL 'ISPLINK' USING I-VDEFINE, DADM-VAR, DEPT-ADMR, 00095100
I-CHAR, DADM-VAR-STG. 00095200
CALL 'ISPLINK' USING I-VDEFINE, DLOC-VAR, DEPT-LOC, 00095300
I-CHAR, DLOC-VAR-STG. 00095400
CALL 'ISPLINK' USING I-VDEFINE, EN2-VAR, EMP-NUMB, 00095500
I-CHAR, EN2-VAR-STG. 00095600
CALL 'ISPLINK' USING I-VDEFINE, EFN2-VAR, EMP-FIRST-NAME, 00095700
I-CHAR, EFN2-VAR-STG. 00095800
CALL 'ISPLINK' USING I-VDEFINE, EMI2-VAR, EMP-MID-INIT, 00095900
I-CHAR, EMI2-VAR-STG. 00096000
CALL 'ISPLINK' USING I-VDEFINE, ELN2-VAR, EMP-LAST-NAME, 00096100
I-CHAR, ELN2-VAR-STG. 00096200
CALL 'ISPLINK' USING I-VDEFINE, EWD-VAR, EMP-WORK-DEPT, 00096300
I-CHAR, EWD-VAR-STG. 00096400
* 00096500
* SELECT DEPARTMENT PANEL 00096600
* 00096700
CALL 'ISPLINK' USING I-VDEFINE, SD-VAR, SEL-DEPT, 00096800
I-CHAR, SD-VAR-STG. 00096900
CALL 'ISPLINK' USING I-VDEFINE, DN3-VAR, DEPT-NUMB, 00097000
I-CHAR, DN3-VAR-STG. 00097100
CALL 'ISPLINK' USING I-VDEFINE, DNAME3-VAR, DEPT-NAME, 00097200
I-CHAR, DNAME3-VAR-STG. 00097300
CALL 'ISPLINK' USING I-VDEFINE, DMGR3-VAR, DEPT-MGR, 00097400
I-CHAR, DMGR3-VAR-STG. 00097500
CALL 'ISPLINK' USING I-VDEFINE, MGRN-VAR, MGR-NAME, 00097600
I-CHAR, MGRN-VAR-STG. 00097700
* 00097800
* SELECT EMPLOYEE PANEL 00097900
* 00098000
CALL 'ISPLINK' USING I-VDEFINE, SEM-VAR, SEL-EMP, 00098100
I-CHAR, SEM-VAR-STG. 00098200
CALL 'ISPLINK' USING I-VDEFINE, EN4-VAR, EMP-NUMB, 00098300
I-CHAR, EN4-VAR-STG. 00098400
CALL 'ISPLINK' USING I-VDEFINE, EMPN-VAR, EMP-NAME, 00098500
I-CHAR, EMPN-VAR-STG. 00098600
CALL 'ISPLINK' USING I-VDEFINE, DN4-VAR, EMP-WORK-DEPT, 00098700
I-CHAR, DN4-VAR-STG. 00098800
CALL 'ISPLINK' USING I-VDEFINE, DNAME4-VAR, DEPT-NAME, 00098900
I-CHAR, DNAME4-VAR-STG. 00099000
* 00099100
CALL 'ISPLINK' USING I-VDEFINE, MSGS-VAR, MSGS, 00099200
I-CHAR, MSGS-VAR-STG. 00099300
* 00099400
*---------------------------------------------------------------* 00099500
* MAIN PROGRAM * 00099600
*---------------------------------------------------------------* 00099700
MOVE 'N' TO SEL-EXIT. 00099800
MOVE SPACES TO PREVLOC. 00099900
PERFORM 1000-MAIN-LOOP THRU 1000-MAIN-LOOP-EXIT 00100000
UNTIL SEL-EXIT = 'Y'. 00100100
MOVE 0 TO RETURN-CODE. 00100200
MOVE SPACES TO MSGS. 00100300
CALL 'ISPLINK' USING I-VPUT, MSGS-VAR. 00100400
GOBACK. 00100500
* 00100600
1000-MAIN-LOOP. 00100700
CALL 'ISPLINK' USING I-DISPLAY, SEL-PANEL. 00100800
IF RETURN-CODE = 8 THEN 00100900
EXEC SQL COMMIT END-EXEC 00101000
EXEC SQL RELEASE ALL SQL END-EXEC 00101100
MOVE 'Y' TO SEL-EXIT 00101200
ELSE 00101300
MOVE SPACES TO MSGS 00101400
MOVE 'N' TO GEND-EXIT, GENE-EXIT 00101500
CALL 'ISPLINK' USING I-VGET, ACTION-VARS 00101600
MOVE NAMEID TO DATAW 00101700
MOVE 0 TO LENGTH-COUNTER 00101800
INSPECT DATAW 00101900
TALLYING LENGTH-COUNTER FOR CHARACTERS 00102000
BEFORE INITIAL SPACE 00102100
IF SEARCH-CRIT = 'DI' AND LENGTH-COUNTER > 3 OR 00102200
SEARCH-CRIT = 'MI' AND LENGTH-COUNTER > 6 OR 00102300
SEARCH-CRIT = 'EI' AND LENGTH-COUNTER > 6 THEN 00102400
MOVE '074E' TO MSGCODE 00102500
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00102600
MOVE OUTMSG TO MSGS 00102700
ELSE 00102800
PERFORM 1100-CONNECT THRU 1100-CONNECT-EXIT 00102900
PERFORM 1200-DOACTION THRU 1200-DOACTION-EXIT. 00103000
1000-MAIN-LOOP-EXIT. 00103100
EXIT. 00103200
* 00103300
*---------------------------------------------------------------* 00103400
* CONNECT TO NEW LOCATION * 00103500
*---------------------------------------------------------------* 00103600
1100-CONNECT. 00103700
IF LOCATION NOT EQUAL TO PREVLOC THEN 00103800
MOVE LOCATION TO PREVLOC 00103900
IF LOCATION NOT EQUAL TO SPACES THEN 00104000
EXEC SQL CONNECT TO :LOCATION END-EXEC 00104100
ELSE 00104200
EXEC SQL CONNECT RESET END-EXEC. 00104300
1100-CONNECT-EXIT. 00104400
EXIT. 00104500
* 00104600
*---------------------------------------------------------------* 00104700
* DETERMINE PROCESSING REQUEST * 00104800
*---------------------------------------------------------------* 00104900
1200-DOACTION. 00105000
IF ACTION = 'A' THEN 00105100
MOVE ' ADD' TO ACTION-LIST 00105200
IF OBJFLD = 'DE' THEN 00105300
PERFORM 2000-ADDDEPT THRU 2000-ADDDEPT-EXIT 00105400
ELSE 00105500
PERFORM 3000-ADDEMP THRU 3000-ADDEMP-EXIT 00105600
ELSE 00105700
PERFORM 4000-ACTION THRU 4000-ACTION-EXIT 00105800
IF OBJFLD = 'DE' OR OBJFLD = 'DS' THEN 00105900
PERFORM 5000-DEPARTMENT THRU 5000-DEPARTMENT-EXIT 00106000
ELSE 00106100
PERFORM 6000-EMPLOYEE THRU 6000-EMPLOYEE-EXIT. 00106200
1200-DOACTION-EXIT. 00106300
EXIT. 00106400
* 00106500
*---------------------------------------------------------------* 00106600
* ADD A DEPARTMENT * 00106700
*---------------------------------------------------------------* 00106800
2000-ADDDEPT. 00106900
CALL 'ISPLINK' USING I-VPUT, IDEN-VAR. 00107000
PERFORM 2100-DISDEPTDATA THRU 2100-DISDEPTDATA-EXIT. 00107100
CALL 'ISPLINK' USING I-VPUT, ADD-DEPT-VARS. 00107200
CALL 'ISPLINK' USING I-DISPLAY, DEPT-PANEL. 00107300
IF RETURN-CODE NOT EQUAL TO 8 THEN 00107400
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC 00107500
MOVE SPACES TO SQLERRP 00107600
EXEC SQL INSERT INTO VHDEPT 00107700
VALUES (:DEPT-NUMB, :DEPT-NAME, :DEPT-MGR, 00107800
:DEPT-ADMR, :DEPT-LOC) 00107900
END-EXEC 00108000
PERFORM 2200-ADDDEPTCODES THRU 2200-ADDDEPTCODES-EXIT 00108100
EXEC SQL WHENEVER SQLERROR GOTO L8000-P3-DBERROR END-EXEC00108200
PERFORM 2300-GETEMPREC THRU 2300-GETEMPREC-EXIT 00108300
CALL 'ISPLINK' USING I-VPUT, DEPT-VARS 00108400
CALL 'ISPLINK' USING I-DISPLAY, DEPT-PANEL. 00108500
2000-ADDDEPT-EXIT. 00108600
EXIT. 00108700
* 00108800
*---------------------------------------------------------------* 00108900
* DISPLAY INPUT DATA ON PANEL * 00109000
*---------------------------------------------------------------* 00109100
2100-DISDEPTDATA. 00109200
MOVE SPACES TO DEPT-RECORD. 00109300
MOVE SPACES TO EMP-RECORD. 00109400
IF SEARCH-CRIT = 'DI' THEN 00109500
MOVE DATAW TO DEPT-NUMB 00109600
ELSE 00109700
IF SEARCH-CRIT = 'DN' THEN 00109800
MOVE DATAW TO DEPT-NAME 00109900
ELSE 00110000
IF SEARCH-CRIT = 'MI' THEN 00110100
MOVE DATAW TO DEPT-MGR. 00110200
2100-DISDEPTDATA-EXIT. 00110300
EXIT. 00110400
* 00110500
*---------------------------------------------------------------* 00110600
* CHECK RETURN CODE FROM INSERT. IF OK, ADD TO OTHER LOCATIONS.* 00110700
*---------------------------------------------------------------* 00110800
2200-ADDDEPTCODES. 00110900
IF SQLERRP = SPACES THEN 00111000
MOVE '079E' TO MSGCODE 00111100
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00111200
MOVE OUTMSG TO MSGS 00111300
ELSE 00111400
IF SQLCODE = -803 THEN 00111500
MOVE '015E' TO MSGCODE 00111600
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00111700
MOVE OUTMSG TO MSGS 00111800
ELSE 00111900
IF SQLCODE = -530 THEN 00112000
UNSTRING SQLERRMC 00112100
DELIMITED BY HIGH-VALUE 00112200
INTO TOKEN 00112300
IF TOKEN = 'RDD' THEN 00112400
MOVE '213E' TO MSGCODE 00112500
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00112600
MOVE OUTMSG TO MSGS 00112700
ELSE 00112800
IF TOKEN = 'RDE' THEN 00112900
MOVE '210E' TO MSGCODE 00113000
CALL 'DSN8MCG' USING MODULE, MSGCODE, 00113100
OUTMSG 00113200
MOVE OUTMSG TO MSGS 00113300
ELSE 00113400
GO TO L8000-P3-DBERROR 00113500
ELSE 00113600
IF SQLCODE NOT EQUAL TO 0 THEN 00113700
GO TO L8000-P3-DBERROR 00113800
ELSE 00113900
EXEC SQL OPEN LOCS END-EXEC 00114000
MOVE 0 TO LOCPTR 00114100
PERFORM 2210-BUILDLOCTABLE THRU 00114200
2210-BUILDLOCTABLE-EXIT 00114300
UNTIL SQLCODE NOT EQUAL TO 0 00114400
EXEC SQL CLOSE LOCS END-EXEC 00114500
MOVE LOCPTR TO LOCTOP 00114600
MOVE 0 TO LOCPTR 00114700
PERFORM 2220-ADDLOCS THRU 2220-ADDLOCS-EXIT 00114800
UNTIL LOCPTR = LOCTOP 00114900
MOVE '012I' TO MSGCODE 00115000
CALL 'DSN8MCG' USING MODULE, MSGCODE, 00115100
OUTMSG 00115200
MOVE OUTMSG TO MSGS 00115300
MOVE DEPT-LOC TO LOCATION 00115400
PERFORM 1100-CONNECT THRU 00115500
1100-CONNECT-EXIT. 00115600
2200-ADDDEPTCODES-EXIT. 00115700
EXIT. 00115800
* 00115900
*---------------------------------------------------------------* 00116000
* BUILD TABLE OF UNIQUE LOCATIONS IN VHDEPT * 00116100
*---------------------------------------------------------------* 00116200
2210-BUILDLOCTABLE. 00116300
EXEC SQL FETCH LOCS INTO :TEMPLOC END-EXEC. 00116400
IF SQLCODE = 0 THEN 00116500
ADD 1 TO LOCPTR 00116600
MOVE TEMPLOC TO LOCLIST (LOCPTR). 00116700
2210-BUILDLOCTABLE-EXIT. 00116800
EXIT. 00116900
* 00117000
*---------------------------------------------------------------* 00117100
* ADD NEW DEPARTMENT TO VHDEPT VIEWS AT ALL LOCATIONS * 00117200
*---------------------------------------------------------------* 00117300
2220-ADDLOCS. 00117400
IF LOCPTR < LOCTOP THEN 00117500
ADD 1 TO LOCPTR 00117600
MOVE LOCLIST (LOCPTR) TO TEMPLOC 00117700
EXEC SQL CONNECT TO :TEMPLOC END-EXEC 00117800
EXEC SQL INSERT INTO VHDEPT 00117900
VALUES (:DEPT-NUMB, :DEPT-NAME, :DEPT-MGR, 00118000
:DEPT-ADMR, :DEPT-LOC) 00118100
END-EXEC. 00118200
2220-ADDLOCS-EXIT. 00118300
EXIT. 00118400
* 00118500
*---------------------------------------------------------------* 00118600
* RETRIEVE MANAGER INFO FOR NEW DEPARTMENT * 00118700
*---------------------------------------------------------------* 00118800
2300-GETEMPREC. 00118900
CALL 'ISPLINK' USING I-VGET, ADD-DEPT-VARS. 00119000
EXEC SQL SELECT * 00119100
INTO :EMP-NUMB, :EMP-FIRST-NAME, 00119200
:EMP-MID-INIT, :EMP-LAST-NAME, 00119300
:EMP-WORK-DEPT:WORK-DEPT-IND 00119400
FROM VEMP 00119500
WHERE EMPNO = :DEPT-MGR 00119600
END-EXEC. 00119700
IF SQLCODE = 100 THEN 00119800
MOVE SPACES TO EMP-RECORD. 00119900
2300-GETEMPREC-EXIT. 00120000
EXIT. 00120100
* 00120200
*---------------------------------------------------------------* 00120300
* ADD AN EMPLOYEE * 00120400
*---------------------------------------------------------------* 00120500
3000-ADDEMP. 00120600
CALL 'ISPLINK' USING I-VPUT, IDEN-VAR. 00120700
PERFORM 3100-DISEMPDATA THRU 3100-DISEMPDATA-EXIT. 00120800
CALL 'ISPLINK' USING I-VPUT, ADD-EMP-VARS. 00120900
CALL 'ISPLINK' USING I-DISPLAY, EMP-PANEL. 00121000
IF RETURN-CODE NOT EQUAL TO 8 THEN 00121100
EXEC SQL OPEN CURDEPTLOC END-EXEC 00121200
PERFORM 3320-SETCURLOC THRU 3320-SETCURLOC-EXIT. 00121300
EXEC SQL CLOSE CURDEPTLOC END-EXEC 00121400
EXEC SQL OPEN DEPTLOC END-EXEC 00121500
EXEC SQL FETCH DEPTLOC INTO :DEPT-LOC END-EXEC 00121600
EXEC SQL CLOSE DEPTLOC END-EXEC 00121700
IF DEPT-LOC NOT EQUAL TO LOCATION THEN 00121800
MOVE '216E' TO MSGCODE 00121900
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00122000
MOVE OUTMSG TO MSGS 00122100
ELSE 00122200
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC 00122300
MOVE SPACES TO SQLERRP 00122400
EXEC SQL INSERT INTO VEMP 00122500
VALUES (:EMP-NUMB, :EMP-FIRST-NAME, 00122600
:EMP-MID-INIT, :EMP-LAST-NAME, 00122700
:EMP-WORK-DEPT) 00122800
END-EXEC 00122900
PERFORM 3200-ADDEMPCODES THRU 3200-ADDEMPCODES-EXIT 00123000
EXEC SQL WHENEVER SQLERROR GOTO L8000-P3-DBERROR 00123100
END-EXEC 00123200
PERFORM 3300-GETDEPTREC THRU 3300-GETDEPTREC-EXIT 00123300
CALL 'ISPLINK' USING I-VPUT, DEPT-VARS 00123400
CALL 'ISPLINK' USING I-DISPLAY, EMP-PANEL. 00123500
3000-ADDEMP-EXIT. 00123600
EXIT. 00123700
* 00123800
*---------------------------------------------------------------* 00123900
* DISPLAY INPUT DATA ON PANEL * 00124000
*---------------------------------------------------------------* 00124100
3100-DISEMPDATA. 00124200
MOVE SPACES TO DEPT-RECORD. 00124300
MOVE SPACES TO EMP-RECORD. 00124400
IF SEARCH-CRIT = 'EI' THEN 00124500
MOVE DATAW TO EMP-NUMB 00124600
ELSE 00124700
IF SEARCH-CRIT = 'EN' THEN 00124800
MOVE DATAW TO EMP-LAST-NAME. 00124900
3100-DISEMPDATA-EXIT. 00125000
EXIT. 00125100
* 00125200
*---------------------------------------------------------------* 00125300
* CHECK RETURN CODE FROM INSERT * 00125400
*---------------------------------------------------------------* 00125500
3200-ADDEMPCODES. 00125600
IF SQLERRP = SPACES THEN 00125700
MOVE '079E' TO MSGCODE 00125800
ELSE 00125900
IF SQLCODE = -803 THEN 00126000
MOVE '005E' TO MSGCODE 00126100
ELSE 00126200
IF SQLCODE = -530 THEN 00126300
MOVE '200E' TO MSGCODE 00126400
ELSE 00126500
IF SQLCODE = 0 THEN 00126600
MOVE '002I' TO MSGCODE 00126700
ELSE 00126800
GO TO L8000-P3-DBERROR. 00126900
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG. 00127000
MOVE OUTMSG TO MSGS. 00127100
3200-ADDEMPCODES-EXIT. 00127200
EXIT. 00127300
* 00127400
*---------------------------------------------------------------* 00127500
* RETRIEVE DEPARTMENT INFO FOR NEW EMPLOYEE * 00127600
*---------------------------------------------------------------* 00127700
3300-GETDEPTREC. 00127800
CALL 'ISPLINK' USING I-VGET, ADD-EMP-VARS. 00127900
EXEC SQL SELECT * 00128000
INTO :DEPT-NUMB, :DEPT-NAME, 00128100
:DEPT-MGR:DEPT-MGR-IND, 00128200
:DEPT-ADMR, :DEPT-LOC 00128300
FROM VHDEPT 00128400
WHERE DEPTNO = :EMP-WORK-DEPT 00128500
END-EXEC. 00128600
IF SQLCODE = 100 THEN 00128700
MOVE SPACES TO DEPT-RECORD 00128800
ELSE 00128900
PERFORM 3310-CHECKDEPTIND THRU 3310-CHECKDEPTIND-EXIT. 00129000
3300-GETDEPTREC-EXIT. 00129100
EXIT. 00129200
* 00129300
*---------------------------------------------------------------* 00129400
* IF MGRNO NULL, MOVE BLANKS INTO FIELD * 00129500
*---------------------------------------------------------------* 00129600
3310-CHECKDEPTIND. 00129700
IF DEPT-MGR-IND < 0 THEN 00129800
MOVE SPACES TO DEPT-MGR. 00129900
3310-CHECKDEPTIND-EXIT. 00130000
EXIT. 00130100
* 00130200
*---------------------------------------------------------------* 00130300
* SET LOCATION TO CURRENT SERVER * 00130400
*---------------------------------------------------------------* 00130500
3320-SETCURLOC. 00130600
IF LOCATION EQUAL TO SPACES THEN 00130700
EXEC SQL FETCH CURDEPTLOC 00130800
INTO :LOCATION 00130900
END-EXEC. 00131000
3320-SETCURLOC-EXIT. 00131100
EXIT. 00131200
* 00131300
*---------------------------------------------------------------* 00131400
* MOVE APPROPRIATE ACTION INTO ACTION-LIST * 00131500
*---------------------------------------------------------------* 00131600
4000-ACTION. 00131700
IF ACTION = 'E' THEN 00131800
MOVE ' ERASE' TO ACTION-LIST 00131900
ELSE 00132000
IF ACTION = 'U' THEN 00132100
MOVE ' UPDATE' TO ACTION-LIST 00132200
ELSE 00132300
MOVE 'DISPLAY' TO ACTION-LIST. 00132400
MOVE 0 TO PERCENT-COUNTER. 00132500
INSPECT DATAW 00132600
TALLYING PERCENT-COUNTER FOR ALL '%'. 00132700
IF PERCENT-COUNTER > 0 THEN 00132800
INSPECT DATAW 00132900
REPLACING ALL ' ' BY '%'. 00133000
4000-ACTION-EXIT. 00133100
EXIT. 00133200
* 00133300
*---------------------------------------------------------------* 00133400
* PERFORM ACTION ON DEPARTMENT OR DEPARTMENT STRUCTURE * 00133500
*---------------------------------------------------------------* 00133600
5000-DEPARTMENT. 00133700
IF NOT (SEARCH-CRIT = 'DI' AND PERCENT-COUNTER = 0) THEN 00133800
MOVE DATAW TO GENDATA 00133900
PERFORM 5100-GENDEPT THRU 5100-GENDEPT-EXIT 00134000
UNTIL GEND-EXIT = 'Y' 00134100
ELSE 00134200
IF OBJFLD = 'DE' THEN 00134300
PERFORM 5200-DISPLAYDEPT THRU 5200-DISPLAYDEPT-EXIT 00134400
ELSE 00134500
PERFORM 5300-STRUCTURE THRU 5300-STRUCTURE-EXIT. 00134600
5000-DEPARTMENT-EXIT. 00134700
EXIT. 00134800
* 00134900
*---------------------------------------------------------------* 00135000
* GENERIC LIST OF DEPARTMENTS * 00135100
*---------------------------------------------------------------* 00135200
5100-GENDEPT. 00135300
CALL 'ISPLINK' USING I-TBCREATE, DEPT-TABLE, W-BLANK, 00135400
SEL-DEPT-VARS, I-NOWRITE, I-REPLACE. 00135500
MOVE SPACE TO SEL-DEPT. 00135600
PERFORM 5110-GETDEPTTAB THRU 5110-GETDEPTTAB-EXIT. 00135700
CALL 'ISPLINK' USING I-TBQUERY, DEPT-TABLE, W-BLANK, 00135800
W-BLANK, QROWS. 00135900
IF NUMROWS = 1 AND GENDATA = DATAW THEN 00136000
MOVE 'Y' TO SPECIAL-EXIT 00136100
CALL 'ISPLINK' USING I-TBGET, DEPT-TABLE 00136200
MOVE DEPT-NUMB TO DATAW 00136300
ELSE 00136400
MOVE 'N' TO SPECIAL-EXIT 00136500
IF NUMROWS = 0 THEN 00136600
PERFORM 5120-DEPTMSG THRU 5120-DEPTMSG-EXIT 00136700
MOVE 'Y' TO GEND-EXIT 00136800
ELSE 00136900
CALL 'ISPLINK' USING I-VPUT, ACTL-VAR 00137000
CALL 'ISPLINK' USING I-TBTOP, DEPT-TABLE 00137100
CALL 'ISPLINK' USING I-TBDISPL, DEPT-TABLE, 00137200
GEND-PANEL 00137300
IF RETURN-CODE = 8 THEN 00137400
MOVE 'Y' TO GEND-EXIT 00137500
ELSE 00137600
IF ROWS-CHANGED > 0 THEN 00137700
CALL 'ISPLINK' USING I-TBGET, DEPT-TABLE 00137800
MOVE DEPT-NUMB TO DATAW 00137900
ELSE 00138000
MOVE 'Y' TO GEND-EXIT. 00138100
IF GEND-EXIT = 'N' THEN 00138200
IF OBJFLD = 'DE' THEN 00138300
PERFORM 5200-DISPLAYDEPT THRU 5200-DISPLAYDEPT-EXIT 00138400
ELSE 00138500
PERFORM 5300-STRUCTURE THRU 5300-STRUCTURE-EXIT. 00138600
IF SPECIAL-EXIT = 'Y' THEN 00138700
MOVE 'Y' TO GEND-EXIT. 00138800
CALL 'ISPLINK' USING I-TBCLOSE, DEPT-TABLE. 00138900
5100-GENDEPT-EXIT. 00139000
EXIT. 00139100
* 00139200
*---------------------------------------------------------------* 00139300
* CREATE TABLE OF DEPARTMENTS TO FIT SEARCH-CRIT * 00139400
*---------------------------------------------------------------* 00139500
5110-GETDEPTTAB. 00139600
IF SEARCH-CRIT = 'DI' THEN 00139700
EXEC SQL OPEN ALLDEPT1 END-EXEC 00139800
MOVE SPACES TO SQLERRP 00139900
PERFORM 5111-ALLDEPT1 THRU 5111-ALLDEPT1-EXIT 00140000
UNTIL SQLCODE NOT EQUAL TO 0 OR GEND-EXIT = 'Y' 00140100
EXEC SQL CLOSE ALLDEPT1 END-EXEC 00140200
ELSE 00140300
IF SEARCH-CRIT = 'DN' AND PERCENT-COUNTER > 0 THEN 00140400
EXEC SQL OPEN ALLDEPT2 END-EXEC 00140500
MOVE SPACES TO SQLERRP 00140600
PERFORM 5112-ALLDEPT2 THRU 5112-ALLDEPT2-EXIT 00140700
UNTIL SQLCODE NOT EQUAL TO 0 OR GEND-EXIT = 'Y' 00140800
EXEC SQL CLOSE ALLDEPT2 END-EXEC 00140900
ELSE 00141000
IF SEARCH-CRIT = 'DN' THEN 00141100
EXEC SQL OPEN ALLDEPT5 END-EXEC 00141200
MOVE SPACES TO SQLERRP 00141300
PERFORM 5113-ALLDEPT5 THRU 5113-ALLDEPT5-EXIT 00141400
UNTIL SQLCODE NOT EQUAL TO 0 OR 00141500
GEND-EXIT = 'Y' 00141600
EXEC SQL CLOSE ALLDEPT5 END-EXEC 00141700
ELSE 00141800
IF SEARCH-CRIT = 'MI' AND 00141900
PERCENT-COUNTER > 0 THEN 00142000
EXEC SQL OPEN ALLDEPT3 END-EXEC 00142100
MOVE SPACES TO SQLERRP 00142200
PERFORM 5114-ALLDEPT3 THRU 00142300
5114-ALLDEPT3-EXIT 00142400
UNTIL SQLCODE NOT EQUAL TO 0 OR 00142500
GEND-EXIT = 'Y' 00142600
EXEC SQL CLOSE ALLDEPT3 END-EXEC 00142700
ELSE 00142800
IF SEARCH-CRIT = 'MI' THEN 00142900
EXEC SQL OPEN ALLDEPT6 END-EXEC 00143000
MOVE SPACES TO SQLERRP 00143100
PERFORM 5115-ALLDEPT6 THRU 00143200
5115-ALLDEPT6-EXIT 00143300
UNTIL SQLCODE NOT EQUAL TO 0 OR 00143400
GEND-EXIT = 'Y' 00143500
EXEC SQL CLOSE ALLDEPT6 END-EXEC 00143600
ELSE 00143700
IF SEARCH-CRIT = 'MN' AND 00143800
PERCENT-COUNTER > 0 THEN 00143900
EXEC SQL OPEN ALLDEPT4 END-EXEC 00144000
MOVE SPACES TO SQLERRP 00144100
PERFORM 5116-ALLDEPT4 THRU 00144200
5116-ALLDEPT4-EXIT 00144300
UNTIL SQLCODE NOT EQUAL TO 0 00144400
OR GEND-EXIT = 'Y' 00144500
EXEC SQL CLOSE ALLDEPT4 END-EXEC 00144600
ELSE 00144700
IF SEARCH-CRIT = 'MN' THEN 00144800
EXEC SQL OPEN ALLDEPT7 END-EXEC 00144900
MOVE SPACES TO SQLERRP 00145000
PERFORM 5117-ALLDEPT7 THRU 00145100
5117-ALLDEPT7-EXIT 00145200
UNTIL SQLCODE NOT EQUAL 00145300
TO 0 OR GEND-EXIT = 'Y' 00145400
EXEC SQL CLOSE ALLDEPT7 00145500
END-EXEC. 00145600
5110-GETDEPTTAB-EXIT. 00145700
EXIT. 00145800
* 00145900
5111-ALLDEPT1. 00146000
EXEC SQL FETCH ALLDEPT1 00146100
INTO :DEPT-NUMB, :DEPT-NAME, 00146200
:DEPT-MGR:DEPT-MGR-IND, 00146300
:MGR-NAME 00146400
END-EXEC. 00146500
IF SQLERRP = SPACES THEN 00146600
MOVE '079E' TO MSGCODE 00146700
MOVE 'Y' TO GEND-EXIT 00146800
ELSE 00146900
IF SQLCODE = 0 THEN 00147000
PERFORM 3310-CHECKDEPTIND THRU 00147100
3310-CHECKDEPTIND-EXIT 00147200
CALL 'ISPLINK' USING I-TBADD, DEPT-TABLE. 00147300
5111-ALLDEPT1-EXIT. 00147400
EXIT. 00147500
* 00147600
5112-ALLDEPT2. 00147700
EXEC SQL FETCH ALLDEPT2 00147800
INTO :DEPT-NUMB, :DEPT-NAME, 00147900
:DEPT-MGR:DEPT-MGR-IND, 00148000
:MGR-NAME 00148100
END-EXEC. 00148200
IF SQLERRP = SPACES THEN 00148300
MOVE '079E' TO MSGCODE 00148400
MOVE 'Y' TO GEND-EXIT 00148500
ELSE 00148600
IF SQLCODE = 0 THEN 00148700
PERFORM 3310-CHECKDEPTIND THRU 00148800
3310-CHECKDEPTIND-EXIT 00148900
CALL 'ISPLINK' USING I-TBADD, DEPT-TABLE. 00149000
5112-ALLDEPT2-EXIT. 00149100
EXIT. 00149200
* 00149300
5113-ALLDEPT5. 00149400
EXEC SQL FETCH ALLDEPT5 00149500
INTO :DEPT-NUMB, :DEPT-NAME, 00149600
:DEPT-MGR:DEPT-MGR-IND, 00149700
:MGR-NAME 00149800
END-EXEC. 00149900
IF SQLERRP = SPACES THEN 00150000
MOVE '079E' TO MSGCODE 00150100
MOVE 'Y' TO GEND-EXIT 00150200
ELSE 00150300
IF SQLCODE = 0 THEN 00150400
PERFORM 3310-CHECKDEPTIND THRU 00150500
3310-CHECKDEPTIND-EXIT 00150600
CALL 'ISPLINK' USING I-TBADD, DEPT-TABLE. 00150700
5113-ALLDEPT5-EXIT. 00150800
EXIT. 00150900
* 00151000
5114-ALLDEPT3. 00151100
EXEC SQL FETCH ALLDEPT3 00151200
INTO :DEPT-NUMB, :DEPT-NAME, 00151300
:DEPT-MGR:DEPT-MGR-IND, 00151400
:MGR-NAME 00151500
END-EXEC. 00151600
IF SQLERRP = SPACES THEN 00151700
MOVE '079E' TO MSGCODE 00151800
MOVE 'Y' TO GEND-EXIT 00151900
ELSE 00152000
IF SQLCODE = 0 THEN 00152100
PERFORM 3310-CHECKDEPTIND THRU 00152200
3310-CHECKDEPTIND-EXIT 00152300
CALL 'ISPLINK' USING I-TBADD, DEPT-TABLE. 00152400
5114-ALLDEPT3-EXIT. 00152500
EXIT. 00152600
* 00152700
5115-ALLDEPT6. 00152800
EXEC SQL FETCH ALLDEPT6 00152900
INTO :DEPT-NUMB, :DEPT-NAME, 00153000
:DEPT-MGR:DEPT-MGR-IND, 00153100
:MGR-NAME 00153200
END-EXEC. 00153300
IF SQLERRP = SPACES THEN 00153400
MOVE '079E' TO MSGCODE 00153500
MOVE 'Y' TO GEND-EXIT 00153600
ELSE 00153700
IF SQLCODE = 0 THEN 00153800
PERFORM 3310-CHECKDEPTIND THRU 00153900
3310-CHECKDEPTIND-EXIT 00154000
CALL 'ISPLINK' USING I-TBADD, DEPT-TABLE. 00154100
5115-ALLDEPT6-EXIT. 00154200
EXIT. 00154300
* 00154400
5116-ALLDEPT4. 00154500
EXEC SQL FETCH ALLDEPT4 00154600
INTO :DEPT-NUMB, :DEPT-NAME, 00154700
:DEPT-MGR:DEPT-MGR-IND, 00154800
:MGR-NAME 00154900
END-EXEC. 00155000
IF SQLERRP = SPACES THEN 00155100
MOVE '079E' TO MSGCODE 00155200
MOVE 'Y' TO GEND-EXIT 00155300
ELSE 00155400
IF SQLCODE = 0 THEN 00155500
PERFORM 3310-CHECKDEPTIND THRU 00155600
3310-CHECKDEPTIND-EXIT 00155700
CALL 'ISPLINK' USING I-TBADD, DEPT-TABLE. 00155800
5116-ALLDEPT4-EXIT. 00155900
EXIT. 00156000
* 00156100
5117-ALLDEPT7. 00156200
EXEC SQL FETCH ALLDEPT7 00156300
INTO :DEPT-NUMB, :DEPT-NAME, 00156400
:DEPT-MGR:DEPT-MGR-IND, 00156500
:MGR-NAME 00156600
END-EXEC. 00156700
IF SQLERRP = SPACES THEN 00156800
MOVE '079E' TO MSGCODE 00156900
MOVE 'Y' TO GEND-EXIT 00157000
ELSE 00157100
IF SQLCODE = 0 THEN 00157200
PERFORM 3310-CHECKDEPTIND THRU 00157300
3310-CHECKDEPTIND-EXIT 00157400
CALL 'ISPLINK' USING I-TBADD, DEPT-TABLE. 00157500
5117-ALLDEPT7-EXIT. 00157600
EXIT. 00157700
* 00157800
*---------------------------------------------------------------* 00157900
* PRINT CORRECT 'DEPARTMENT NOT FOUND' MESSAGE * 00158000
*---------------------------------------------------------------* 00158100
5120-DEPTMSG. 00158200
IF MSGCODE NOT EQUAL TO '079E' THEN 00158300
IF ACTION = 'E' THEN 00158400
MOVE '016E' TO MSGCODE 00158500
ELSE 00158600
IF ACTION = 'U' THEN 00158700
MOVE '017E' TO MSGCODE 00158800
ELSE 00158900
MOVE '011I' TO MSGCODE. 00159000
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00159100
MOVE OUTMSG TO MSGS. 00159200
5120-DEPTMSG-EXIT. 00159300
EXIT. 00159400
* 00159500
*---------------------------------------------------------------* 00159600
* DISPLAY A DEPARTMENT * 00159700
*---------------------------------------------------------------* 00159800
5200-DISPLAYDEPT. 00159900
MOVE SPACES TO DEPT-RECORD. 00160000
MOVE SPACES TO EMP-RECORD. 00160100
EXEC SQL OPEN DEPT1 END-EXEC. 00160200
MOVE SPACES TO SQLERRP. 00160300
EXEC SQL FETCH DEPT1 INTO :DEPT-NUMB, :DEPT-NAME, 00160400
:DEPT-MGR:DEPT-MGR-IND, 00160500
:DEPT-ADMR, :DEPT-LOC, 00160600
:EMP-NUMB, :EMP-FIRST-NAME, 00160700
:EMP-MID-INIT, :EMP-LAST-NAME, 00160800
:EMP-WORK-DEPT:WORK-DEPT-IND 00160900
END-EXEC. 00161000
PERFORM 5210-DISDEPTACT THRU 5210-DISDEPTACT-EXIT. 00161100
5200-DISPLAYDEPT-EXIT. 00161200
EXIT. 00161300
* 00161400
*---------------------------------------------------------------* 00161500
* DISPLAY, ERASE, OR UPDATE DEPARTMENT * 00161600
*---------------------------------------------------------------* 00161700
5210-DISDEPTACT. 00161800
IF SQLERRP = SPACES THEN 00161900
EXEC SQL CLOSE DEPT1 END-EXEC 00162000
MOVE '079E' TO MSGCODE 00162100
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00162200
MOVE OUTMSG TO MSGS 00162300
ELSE 00162400
IF SQLCODE = 100 THEN 00162500
EXEC SQL CLOSE DEPT1 END-EXEC 00162600
PERFORM 5120-DEPTMSG THRU 5120-DEPTMSG-EXIT 00162700
ELSE 00162800
EXEC SQL CLOSE DEPT1 END-EXEC 00162900
PERFORM 3310-CHECKDEPTIND THRU 00163000
3310-CHECKDEPTIND-EXIT 00163100
CALL 'ISPLINK' USING I-DISPLAY, DEPT-PANEL 00163200
IF RETURN-CODE NOT EQUAL TO 8 THEN 00163300
IF ACTION = 'E' THEN 00163400
PERFORM 5220-ERASEDEPT THRU 00163500
5220-ERASEDEPT-EXIT 00163600
ELSE 00163700
IF ACTION = 'U' THEN 00163800
PERFORM 5230-UPDATEDEPT THRU 00163900
5230-UPDATEDEPT-EXIT. 00164000
5210-DISDEPTACT-EXIT. 00164100
EXIT. 00164200
* 00164300
*---------------------------------------------------------------* 00164400
* ERASE A DEPARTMENT * 00164500
*---------------------------------------------------------------* 00164600
5220-ERASEDEPT. 00164700
MOVE 1 TO DEPTPTR. 00164800
MOVE 0 TO LISTPTR. 00164900
MOVE DATAW TO DEPTS (DEPTPTR). 00165000
PERFORM 5221-DELDEPTS THRU 5221-DELDEPTS-EXIT 00165100
UNTIL DEPTPTR = 0. 00165200
MOVE LISTPTR TO STACKTOP. 00165300
PERFORM 5223-DELDEPEND THRU 5223-DELDEPEND-EXIT 00165400
UNTIL LISTPTR = 0. 00165500
EXEC SQL OPEN LOCS END-EXEC. 00165600
MOVE 0 TO LOCPTR. 00165700
PERFORM 2210-BUILDLOCTABLE THRU 2210-BUILDLOCTABLE-EXIT 00165800
UNTIL SQLCODE NOT EQUAL TO 0. 00165900
EXEC SQL CLOSE LOCS END-EXEC. 00166000
MOVE LOCPTR TO LOCTOP. 00166100
MOVE 0 TO LOCPTR. 00166200
PERFORM 5224-DELETELOCS THRU 5224-DELETELOCS-EXIT 00166300
UNTIL LOCPTR = LOCTOP. 00166400
MOVE '013I' TO MSGCODE. 00166500
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG. 00166600
MOVE OUTMSG TO MSGS. 00166700
PERFORM 1100-CONNECT THRU 1100-CONNECT-EXIT. 00166800
5220-ERASEDEPT-EXIT. 00166900
EXIT. 00167000
* 00167100
*---------------------------------------------------------------* 00167200
* ERASE DEPARTMENT FROM OTHER LOCATIONS * 00167300
*---------------------------------------------------------------* 00167400
5221-DELDEPTS. 00167500
ADD 1 TO LISTPTR. 00167600
MOVE DEPTS (DEPTPTR) TO DEPTLIST (LISTPTR). 00167700
MOVE DEPTS (DEPTPTR) TO CURDEPT. 00167800
SUBTRACT 1 FROM DEPTPTR. 00167900
EXEC SQL OPEN SUBDEPTS END-EXEC. 00168000
PERFORM 5222-GETSUBDEPTS THRU 5222-GETSUBDEPTS-EXIT 00168100
UNTIL SQLCODE NOT EQUAL TO 0. 00168200
EXEC SQL CLOSE SUBDEPTS END-EXEC. 00168300
5221-DELDEPTS-EXIT. 00168400
EXIT. 00168500
* 00168600
*---------------------------------------------------------------* 00168700
* BUILD TABLE OF DEPARTMENTS DEPENDENT ON ERASED DEPARTMENTS * 00168800
* AND DEPARTMENTS DEPENDENT ON THOSE DEPARTMENTS ETC. * 00168900
*---------------------------------------------------------------* 00169000
5222-GETSUBDEPTS. 00169100
EXEC SQL FETCH SUBDEPTS INTO :TEMPDEPT END-EXEC. 00169200
IF SQLCODE = 0 THEN 00169300
ADD 1 TO DEPTPTR 00169400
MOVE TEMPDEPT TO DEPTS (DEPTPTR). 00169500
5222-GETSUBDEPTS-EXIT. 00169600
EXIT. 00169700
* 00169800
*---------------------------------------------------------------* 00169900
* ENOFORCE REFERENTIAL INTEGRITY RULE ON VHDEPT BY CASCADE * 00170000
* DELETING DEPARTMENTS DEPENDENT ON DELETED DEPARTMENTS * 00170100
*---------------------------------------------------------------* 00170200
5223-DELDEPEND. 00170300
MOVE DEPTLIST (LISTPTR) TO DELDEPT. 00170400
EXEC SQL DELETE FROM VHDEPT 00170500
WHERE DEPTNO = :DELDEPT 00170600
END-EXEC. 00170700
SUBTRACT 1 FROM LISTPTR. 00170800
5223-DELDEPEND-EXIT. 00170900
EXIT. 00171000
* 00171100
*---------------------------------------------------------------* 00171200
* PERFORM CASCADE DELETE AT ALL LOCATIONS * 00171300
*---------------------------------------------------------------* 00171400
5224-DELETELOCS. 00171500
IF LOCPTR < LOCTOP THEN 00171600
ADD 1 TO LOCPTR 00171700
MOVE LOCLIST (LOCPTR) TO TEMPLOC 00171800
EXEC SQL CONNECT TO :TEMPLOC END-EXEC 00171900
MOVE STACKTOP TO LISTPTR 00172000
PERFORM 5223-DELDEPEND THRU 5223-DELDEPEND-EXIT 00172100
UNTIL LISTPTR = 0. 00172200
5224-DELETELOCS-EXIT. 00172300
EXIT. 00172400
* 00172500
*---------------------------------------------------------------* 00172600
* UPDATE A DEPARTMENT * 00172700
*---------------------------------------------------------------* 00172800
5230-UPDATEDEPT. 00172900
PERFORM 2300-GETEMPREC THRU 2300-GETEMPREC-EXIT. 00173000
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC. 00173100
EXEC SQL UPDATE VHDEPT 00173200
SET DEPTNAME = :DEPT-NAME, 00173300
MGRNO = :DEPT-MGR, 00173400
ADMRDEPT = :DEPT-ADMR, 00173500
LOCATION = :DEPT-LOC 00173600
WHERE DEPTNO = :DATAW 00173700
END-EXEC. 00173800
IF SQLCODE = -530 THEN 00173900
UNSTRING SQLERRMC 00174000
DELIMITED BY HIGH-VALUE 00174100
INTO TOKEN 00174200
IF TOKEN = 'RDD' THEN 00174300
MOVE '215E' TO MSGCODE 00174400
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00174500
MOVE OUTMSG TO MSGS 00174600
ELSE 00174700
IF TOKEN = 'RDE' THEN 00174800
MOVE '214E' TO MSGCODE 00174900
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00175000
MOVE OUTMSG TO MSGS 00175100
ELSE 00175200
GO TO L8000-P3-DBERROR 00175300
ELSE 00175400
IF SQLCODE NOT EQUAL TO 0 THEN 00175500
GO TO L8000-P3-DBERROR 00175600
ELSE 00175700
EXEC SQL WHENEVER SQLERROR GOTO L8000-P3-DBERROR 00175800
END-EXEC 00175900
EXEC SQL OPEN LOCS END-EXEC 00176000
MOVE 0 TO LOCPTR 00176100
PERFORM 2210-BUILDLOCTABLE THRU 00176200
2210-BUILDLOCTABLE-EXIT 00176300
UNTIL SQLCODE NOT EQUAL TO 0 00176400
EXEC SQL CLOSE LOCS END-EXEC 00176500
MOVE LOCPTR TO LOCTOP 00176600
MOVE 0 TO LOCPTR 00176700
PERFORM 5231-UPDATELOCS THRU 00176800
5231-UPDATELOCS-EXIT 00176900
UNTIL LOCPTR = LOCTOP 00177000
MOVE '014I' TO MSGCODE 00177100
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00177200
MOVE OUTMSG TO MSGS 00177300
PERFORM 1100-CONNECT THRU 1100-CONNECT-EXIT 00177400
EXEC SQL WHENEVER SQLERROR GOTO L8000-P3-DBERROR END-EXEC. 00177500
CALL 'ISPLINK' USING I-DISPLAY, DEPT-PANEL. 00177600
5230-UPDATEDEPT-EXIT. 00177700
EXIT. 00177800
* 00177900
*---------------------------------------------------------------* 00178000
* UPDATE DEPARTMENT TO VHDEPT VIEWS AT ALL LOCATIONS * 00178100
*---------------------------------------------------------------* 00178200
5231-UPDATELOCS. 00178300
IF LOCPTR < LOCTOP THEN 00178400
ADD 1 TO LOCPTR 00178500
MOVE LOCLIST (LOCPTR) TO TEMPLOC 00178600
EXEC SQL CONNECT TO :TEMPLOC END-EXEC 00178700
EXEC SQL UPDATE VHDEPT 00178800
SET DEPTNAME = :DEPT-NAME, 00178900
MGRNO = :DEPT-MGR, 00179000
ADMRDEPT = :DEPT-ADMR, 00179100
LOCATION = :DEPT-LOC 00179200
WHERE DEPTNO = :DEPT-NUMB 00179300
END-EXEC. 00179400
5231-UPDATELOCS-EXIT. 00179500
EXIT. 00179600
* 00179700
*---------------------------------------------------------------* 00179800
* DISPLAY DEPARTMENT STRUCTURE * 00179900
*---------------------------------------------------------------* 00180000
5300-STRUCTURE. 00180100
MOVE SPACES TO DEPT-RECORD. 00180200
MOVE SPACES TO EMP-RECORD. 00180300
MOVE SPACES TO DEPT1-RECORD. 00180400
MOVE SPACES TO EMP1-RECORD. 00180500
EXEC SQL OPEN DEPT1 END-EXEC. 00180600
MOVE SPACES TO SQLERRP. 00180700
EXEC SQL FETCH DEPT1 INTO :DEPT1-NUMB, :DEPT1-NAME, 00180800
:DEPT1-MGR:DEPT1-MGR-IND, 00180900
:DEPT1-ADMR, :DEPT1-LOC, 00181000
:EMP-NUMB, 00181100
:EMP1-FIRST-NAME, 00181200
:EMP1-MID-INIT, 00181300
:EMP1-LAST-NAME, 00181400
:EMP1-WORK-DEPT:WORK1-DEPT-IND 00181500
END-EXEC. 00181600
PERFORM 5310-DISSTR THRU 5310-DISSTR-EXIT. 00181700
5300-STRUCTURE-EXIT. 00181800
EXIT. 00181900
* 00182000
*---------------------------------------------------------------* 00182100
* DISPLAY DEPARTMENTS REPORTING TO SELECTED DEPARTMENT * 00182200
*---------------------------------------------------------------* 00182300
5310-DISSTR. 00182400
IF SQLERRP = SPACES THEN 00182500
EXEC SQL CLOSE DEPT1 END-EXEC 00182600
MOVE '079E' TO MSGCODE 00182700
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00182800
MOVE OUTMSG TO MSGS 00182900
ELSE 00183000
IF SQLCODE = 100 THEN 00183100
EXEC SQL CLOSE DEPT1 END-EXEC 00183200
MOVE '011I' TO MSGCODE 00183300
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00183400
MOVE OUTMSG TO MSGS 00183500
ELSE 00183600
EXEC SQL CLOSE DEPT1 END-EXEC 00183700
PERFORM 5311-CHECKDEPT1IND THRU 00183800
5311-CHECKDEPT1IND-EXIT 00183900
CALL 'ISPLINK' USING I-TBCREATE, DS-TABLE, W-BLANK, 00184000
DS-VARS, I-NOWRITE, I-REPLACE 00184100
EXEC SQL OPEN DEPTSTR END-EXEC 00184200
PERFORM 5312-GETSTRTAB THRU 5312-GETSTRTAB-EXIT 00184300
UNTIL SQLCODE NOT EQUAL TO 0 00184400
EXEC SQL CLOSE DEPTSTR END-EXEC 00184500
CALL 'ISPLINK' USING I-TBTOP, DS-TABLE 00184600
CALL 'ISPLINK' USING I-TBDISPL, DS-TABLE, STR-PANEL 00184700
CALL 'ISPLINK' USING I-VPUT, HEAD-DEPT-VARS 00184800
CALL 'ISPLINK' USING I-TBCLOSE, DS-TABLE. 00184900
5310-DISSTR-EXIT. 00185000
EXIT. 00185100
* 00185200
*---------------------------------------------------------------* 00185300
* IF MGRNO NULL, MOVE BLANKS INTO FIELD * 00185400
*---------------------------------------------------------------* 00185500
5311-CHECKDEPT1IND. 00185600
IF DEPT1-MGR-IND < 0 THEN 00185700
MOVE SPACES TO DEPT1-MGR. 00185800
5311-CHECKDEPT1IND-EXIT. 00185900
EXIT. 00186000
* 00186100
*---------------------------------------------------------------* 00186200
* CREATE LIST OF DEPARTMENTS REPORTING TO SELECTED DEPARTMENT * 00186300
*---------------------------------------------------------------* 00186400
5312-GETSTRTAB. 00186500
EXEC SQL FETCH DEPTSTR 00186600
INTO :DEPT-NUMB, :DEPT-NAME, 00186700
:DEPT-MGR:DEPT-MGR-IND, 00186800
:DEPT-ADMR, :DEPT-LOC, 00186900
:EMP-FIRST-NAME, :EMP-MID-INIT, 00187000
:EMP-LAST-NAME 00187100
END-EXEC. 00187200
IF SQLCODE = 0 THEN 00187300
PERFORM 3310-CHECKDEPTIND THRU 3310-CHECKDEPTIND-EXIT 00187400
CALL 'ISPLINK' USING I-TBADD, DS-TABLE. 00187500
5312-GETSTRTAB-EXIT. 00187600
EXIT. 00187700
* 00187800
*---------------------------------------------------------------* 00187900
* PERFORM ACTION ON EMPLOYEE * 00188000
*---------------------------------------------------------------* 00188100
6000-EMPLOYEE. 00188200
IF NOT (SEARCH-CRIT = 'EI' AND PERCENT-COUNTER = 0) THEN 00188300
MOVE DATAW TO GENDATA 00188400
PERFORM 6100-GENEMP THRU 6100-GENEMP-EXIT 00188500
UNTIL GENE-EXIT = 'Y' 00188600
ELSE 00188700
PERFORM 6200-DISPLAYEMP THRU 6200-DISPLAYEMP-EXIT. 00188800
6000-EMPLOYEE-EXIT. 00188900
EXIT. 00189000
* 00189100
*---------------------------------------------------------------* 00189200
* GENERIC LIST OF EMPLOYEES * 00189300
*---------------------------------------------------------------* 00189400
6100-GENEMP. 00189500
CALL 'ISPLINK' USING I-TBCREATE, EMP-TABLE, W-BLANK, 00189600
SEL-EMP-VARS, I-NOWRITE, I-REPLACE. 00189700
MOVE SPACE TO SEL-EMP. 00189800
PERFORM 6110-GETEMPTAB THRU 6110-GETEMPTAB-EXIT. 00189900
CALL 'ISPLINK' USING I-TBQUERY, EMP-TABLE, W-BLANK, W-BLANK, 00190000
QROWS. 00190100
IF NUMROWS = 1 AND DATAW = GENDATA THEN 00190200
MOVE 'Y' TO SPECIAL-EXIT 00190300
CALL 'ISPLINK' USING I-TBGET, EMP-TABLE 00190400
MOVE EMP-NUMB TO DATAW 00190500
ELSE 00190600
MOVE 'N' TO SPECIAL-EXIT 00190700
IF NUMROWS = 0 THEN 00190800
PERFORM 6120-EMPMSG THRU 6120-EMPMSG-EXIT 00190900
MOVE 'Y' TO GENE-EXIT 00191000
ELSE 00191100
CALL 'ISPLINK' USING I-VPUT, ACTL-VAR 00191200
CALL 'ISPLINK' USING I-TBTOP, EMP-TABLE 00191300
CALL 'ISPLINK' USING I-TBDISPL, EMP-TABLE, 00191400
GENE-PANEL 00191500
IF RETURN-CODE = 8 THEN 00191600
MOVE 'Y' TO GENE-EXIT 00191700
ELSE 00191800
IF ROWS-CHANGED > 0 THEN 00191900
CALL 'ISPLINK' USING I-TBGET, EMP-TABLE 00192000
MOVE EMP-NUMB TO DATAW 00192100
ELSE 00192200
MOVE 'Y' TO GENE-EXIT. 00192300
IF GENE-EXIT = 'N' THEN 00192400
PERFORM 6200-DISPLAYEMP THRU 6200-DISPLAYEMP-EXIT. 00192500
IF SPECIAL-EXIT = 'Y' THEN 00192600
MOVE 'Y' TO GENE-EXIT. 00192700
CALL 'ISPLINK' USING I-TBCLOSE, EMP-TABLE. 00192800
6100-GENEMP-EXIT. 00192900
EXIT. 00193000
* 00193100
*---------------------------------------------------------------* 00193200
* CREATE TABLE OF EMPLOYEES TO FIT SEARCH-CRIT * 00193300
*---------------------------------------------------------------* 00193400
6110-GETEMPTAB. 00193500
IF SEARCH-CRIT = 'EI' THEN 00193600
EXEC SQL OPEN ALLEMP1 END-EXEC 00193700
MOVE SPACES TO SQLERRP 00193800
PERFORM 6111-ALLEMP1 THRU 6111-ALLEMP1-EXIT 00193900
UNTIL SQLCODE NOT EQUAL TO 0 OR GENE-EXIT = 'Y' 00194000
EXEC SQL CLOSE ALLEMP1 END-EXEC 00194100
ELSE 00194200
IF SEARCH-CRIT = 'EN' AND PERCENT-COUNTER > 0 THEN 00194300
EXEC SQL OPEN ALLEMP2 END-EXEC 00194400
MOVE SPACES TO SQLERRP 00194500
PERFORM 6112-ALLEMP2 THRU 6112-ALLEMP2-EXIT 00194600
UNTIL SQLCODE NOT EQUAL TO 0 OR GENE-EXIT = 'Y' 00194700
EXEC SQL CLOSE ALLEMP2 END-EXEC 00194800
ELSE 00194900
EXEC SQL OPEN ALLEMP3 END-EXEC 00195000
MOVE SPACES TO SQLERRP 00195100
PERFORM 6113-ALLEMP3 THRU 6113-ALLEMP3-EXIT 00195200
UNTIL SQLCODE NOT EQUAL TO 0 OR GENE-EXIT = 'Y' 00195300
EXEC SQL CLOSE ALLEMP3 END-EXEC. 00195400
6110-GETEMPTAB-EXIT. 00195500
EXIT. 00195600
* 00195700
6111-ALLEMP1. 00195800
EXEC SQL FETCH ALLEMP1 00195900
INTO :EMP-NUMB, :EMP-NAME, 00196000
:EMP-WORK-DEPT:WORK-DEPT-IND, 00196100
:DEPT-NAME 00196200
END-EXEC. 00196300
IF SQLERRP = SPACES THEN 00196400
MOVE '079E' TO MSGCODE 00196500
MOVE 'Y' TO GENE-EXIT 00196600
ELSE 00196700
IF SQLCODE = 0 THEN 00196800
PERFORM 6114-CHECKEMPIND THRU 6114-CHECKEMPIND-EXIT 00196900
CALL 'ISPLINK' USING I-TBADD, EMP-TABLE. 00197000
6111-ALLEMP1-EXIT. 00197100
EXIT. 00197200
* 00197300
6112-ALLEMP2. 00197400
EXEC SQL FETCH ALLEMP2 00197500
INTO :EMP-NUMB, :EMP-NAME, 00197600
:EMP-WORK-DEPT:WORK-DEPT-IND, 00197700
:DEPT-NAME 00197800
END-EXEC. 00197900
IF SQLERRP = SPACES THEN 00198000
MOVE '079E' TO MSGCODE 00198100
MOVE 'Y' TO GENE-EXIT 00198200
ELSE 00198300
IF SQLCODE = 0 THEN 00198400
PERFORM 6114-CHECKEMPIND THRU 6114-CHECKEMPIND-EXIT 00198500
CALL 'ISPLINK' USING I-TBADD, EMP-TABLE. 00198600
6112-ALLEMP2-EXIT. 00198700
EXIT. 00198800
* 00198900
6113-ALLEMP3. 00199000
EXEC SQL FETCH ALLEMP3 00199100
INTO :EMP-NUMB, :EMP-NAME, 00199200
:EMP-WORK-DEPT:WORK-DEPT-IND, 00199300
:DEPT-NAME 00199400
END-EXEC. 00199500
IF SQLERRP = SPACES THEN 00199600
MOVE '079E' TO MSGCODE 00199700
MOVE 'Y' TO GENE-EXIT 00199800
ELSE 00199900
IF SQLCODE = 0 THEN 00200000
PERFORM 6114-CHECKEMPIND THRU 6114-CHECKEMPIND-EXIT 00200100
CALL 'ISPLINK' USING I-TBADD, EMP-TABLE. 00200200
6113-ALLEMP3-EXIT. 00200300
EXIT. 00200400
* 00200500
*---------------------------------------------------------------* 00200600
* IF WORKDEPT NULL, MOVE BLANKS INTO FIELD * 00200700
*---------------------------------------------------------------* 00200800
6114-CHECKEMPIND. 00200900
IF WORK-DEPT-IND < 0 THEN 00201000
MOVE SPACES TO EMP-WORK-DEPT. 00201100
6114-CHECKEMPIND-EXIT. 00201200
EXIT. 00201300
* 00201400
*---------------------------------------------------------------* 00201500
* PRINT CORRECT 'EMPLOYEE NOT FOUND' MESSAGE * 00201600
*---------------------------------------------------------------* 00201700
6120-EMPMSG. 00201800
IF MSGCODE NOT EQUAL TO '079E' THEN 00201900
IF ACTION = 'E' THEN 00202000
MOVE '006E' TO MSGCODE 00202100
ELSE 00202200
IF ACTION = 'U' THEN 00202300
MOVE '007E' TO MSGCODE 00202400
ELSE 00202500
MOVE '001I' TO MSGCODE. 00202600
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00202700
MOVE OUTMSG TO MSGS. 00202800
6120-EMPMSG-EXIT. 00202900
EXIT. 00203000
* 00203100
*---------------------------------------------------------------* 00203200
* DISPLAY AN EMPLOYEE * 00203300
*---------------------------------------------------------------* 00203400
6200-DISPLAYEMP. 00203500
MOVE SPACES TO DEPT-RECORD. 00203600
MOVE SPACES TO EMP-RECORD. 00203700
EXEC SQL OPEN EMP1 END-EXEC. 00203800
MOVE SPACES TO SQLERRP. 00203900
EXEC SQL FETCH EMP1 INTO :DEPT-NUMB, :DEPT-NAME, 00204000
:DEPT-MGR:DEPT-MGR-IND, 00204100
:DEPT-ADMR, :DEPT-LOC, 00204200
:EMP-NUMB, :EMP-FIRST-NAME, 00204300
:EMP-MID-INIT, :EMP-LAST-NAME, 00204400
:EMP-WORK-DEPT:WORK-DEPT-IND 00204500
END-EXEC. 00204600
PERFORM 6210-DISEMPACT THRU 6210-DISEMPACT-EXIT. 00204700
6200-DISPLAYEMP-EXIT. 00204800
EXIT. 00204900
* 00205000
*---------------------------------------------------------------* 00205100
* DISPLAY, ERASE, OR UPDATE EMPLOYEE * 00205200
*---------------------------------------------------------------* 00205300
6210-DISEMPACT. 00205400
IF SQLERRP = SPACES THEN 00205500
EXEC SQL CLOSE EMP1 END-EXEC 00205600
MOVE '079E' TO MSGCODE 00205700
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00205800
MOVE OUTMSG TO MSGS 00205900
ELSE 00206000
IF SQLCODE = 100 THEN 00206100
EXEC SQL CLOSE EMP1 END-EXEC 00206200
PERFORM 6120-EMPMSG THRU 6120-EMPMSG-EXIT 00206300
ELSE 00206400
EXEC SQL CLOSE EMP1 END-EXEC 00206500
PERFORM 3310-CHECKDEPTIND THRU 00206600
3310-CHECKDEPTIND-EXIT 00206700
CALL 'ISPLINK' USING I-DISPLAY, EMP-PANEL 00206800
IF RETURN-CODE NOT EQUAL TO 8 THEN 00206900
IF ACTION = 'E' THEN 00207000
PERFORM 6220-ERASEEMP THRU 00207100
6220-ERASEEMP-EXIT 00207200
ELSE 00207300
IF ACTION = 'U' THEN 00207400
PERFORM 6230-UPDATEEMP THRU 00207500
6230-UPDATEEMP-EXIT. 00207600
6210-DISEMPACT-EXIT. 00207700
EXIT. 00207800
* 00207900
*---------------------------------------------------------------* 00208000
* ERASE AN EMPLOYEE * 00208100
*---------------------------------------------------------------* 00208200
6220-ERASEEMP. 00208300
EXEC SQL DELETE FROM VEMP 00208400
WHERE EMPNO = :DATAW 00208500
END-EXEC. 00208600
IF SQLCODE = 0 THEN 00208700
MOVE '003I' TO MSGCODE 00208800
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00208900
MOVE OUTMSG TO MSGS. 00209000
6220-ERASEEMP-EXIT. 00209100
EXIT. 00209200
* 00209300
*---------------------------------------------------------------* 00209400
* UPDATE AN EMPLOYEE * 00209500
*---------------------------------------------------------------* 00209600
6230-UPDATEEMP. 00209700
PERFORM 3300-GETDEPTREC THRU 3300-GETDEPTREC-EXIT. 00209800
EXEC SQL OPEN CURDEPTLOC END-EXEC 00209900
PERFORM 3320-SETCURLOC THRU 3320-SETCURLOC-EXIT. 00210000
EXEC SQL CLOSE CURDEPTLOC END-EXEC 00210100
IF DEPT-LOC NOT EQUAL TO LOCATION THEN 00210200
MOVE '217E' TO MSGCODE 00210300
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00210400
MOVE OUTMSG TO MSGS 00210500
ELSE 00210600
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC 00210700
EXEC SQL UPDATE VEMP 00210800
SET FIRSTNME = :EMP-FIRST-NAME, 00210900
MIDINIT = :EMP-MID-INIT, 00211000
LASTNAME = :EMP-LAST-NAME, 00211100
WORKDEPT = :EMP-WORK-DEPT 00211200
WHERE EMPNO = :DATAW 00211300
END-EXEC 00211400
IF SQLCODE = -530 THEN 00211500
MOVE '203E' TO MSGCODE 00211600
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00211700
MOVE OUTMSG TO MSGS 00211800
ELSE 00211900
IF SQLCODE = 0 THEN 00212000
MOVE '004I' TO MSGCODE 00212100
CALL 'DSN8MCG' USING MODULE, MSGCODE, OUTMSG 00212200
MOVE OUTMSG TO MSGS 00212300
ELSE 00212400
GO TO L8000-P3-DBERROR. 00212500
CALL 'ISPLINK' USING I-DISPLAY, EMP-PANEL. 00212600
6230-UPDATEEMP-EXIT. 00212700
EXIT. 00212800
* 00212900
*--------------------------------------------------------------* 00213000
* DB2 ERROR PROCESSING * 00213100
*--------------------------------------------------------------* 00213200
L8000-P3-DBERROR. 00213300
00213400
MOVE SQLCAID TO SQLCAID-VALUE. 00213500
MOVE SQLCABC TO CONV. 00213600
MOVE CONV TO SQLCABC-VALUE. 00213700
MOVE SQLCODE TO CONV. 00213800
MOVE CONV TO SQLCODE-VALUE, SQLCODE-MSG. 00213900
MOVE SQLERRML TO CONV. 00214000
MOVE CONV TO SQLERRML-VALUE. 00214100
MOVE SQLERRMC TO SQLERRMC-VALUE. 00214200
MOVE SQLERRP TO SQLERRP-VALUE. 00214300
MOVE SQLERRD (1) TO CONV. 00214400
MOVE CONV TO SQLERRD1-VALUE. 00214500
MOVE SQLERRD (2) TO CONV. 00214600
MOVE CONV TO SQLERRD2-VALUE. 00214700
MOVE SQLERRD (3) TO CONV. 00214800
MOVE CONV TO SQLERRD3-VALUE. 00214900
MOVE SQLERRD (4) TO CONV. 00215000
MOVE CONV TO SQLERRD4-VALUE. 00215100
MOVE SQLERRD (5) TO CONV. 00215200
MOVE CONV TO SQLERRD5-VALUE. 00215300
MOVE SQLERRD (6) TO CONV. 00215400
MOVE CONV TO SQLERRD6-VALUE. 00215500
MOVE SQLWARN0 TO SQLWARN0-VALUE. 00215600
MOVE SQLWARN1 TO SQLWARN1-VALUE. 00215700
MOVE SQLWARN2 TO SQLWARN2-VALUE. 00215800
MOVE SQLWARN3 TO SQLWARN3-VALUE. 00215900
MOVE SQLWARN4 TO SQLWARN4-VALUE. 00216000
MOVE SQLWARN5 TO SQLWARN5-VALUE. 00216100
MOVE SQLWARN6 TO SQLWARN6-VALUE. 00216200
MOVE SQLWARN7 TO SQLWARN7-VALUE. 00216300
MOVE SQLWARN8 TO SQLWARN8-VALUE. 00216400
MOVE SQLWARN9 TO SQLWARN9-VALUE. 00216500
MOVE SQLWARNA TO SQLWARNA-VALUE. 00216600
MOVE SQLSTATE TO SQLSTATE-VALUE. 00216700
00216800
OPEN OUTPUT MSGOUT. 00216900
WRITE MSGREC FROM SQLCA-LINE0. 00217000
WRITE MSGREC FROM SQLCA-LINE1. 00217100
WRITE MSGREC FROM SQLCA-LINE2. 00217200
WRITE MSGREC FROM SQLCA-LINE3. 00217300
WRITE MSGREC FROM SQLCA-LINE4. 00217400
WRITE MSGREC FROM SQLCA-LINE5. 00217500
WRITE MSGREC FROM SQLCA-LINE6. 00217600
WRITE MSGREC FROM SQLCA-LINE7. 00217700
WRITE MSGREC FROM SQLCA-LINE8. 00217800
WRITE MSGREC FROM SQLCA-LINE9. 00217900
WRITE MSGREC FROM SQLCA-LINE10. 00218000
WRITE MSGREC FROM SQLCA-LINE11. 00218100
WRITE MSGREC FROM SQLCA-LINE12. 00218200
WRITE MSGREC FROM SQLCA-LINE13. 00218300
WRITE MSGREC FROM SQLCA-LINE14. 00218400
CLOSE MSGOUT. 00218500
00218600
GOBACK. 00218700