DSN8MCD
THIS MODULE BUILDS A DEPARTMENT STRUCTURE, COMPOSED OF A SELECTED DEPARTMENT AND ITS SUBDEPARTMENTS AND EMPLOYEES.
******DSN8MCD - DEPARTMENT STRUCTURE - DETAIL MODULE - COBOL******00010000
* 00020000
* MODULE NAME = DSN8MCD 00030000
* 00040000
* DESCRIPTIVE NAME = DB2 SAMPLE APPLICATION 00050000
* DEPARTMENT STRUCTURE - DETAIL MODULE 00060000
* COBOL 00070000
* ORGANIZATION 00080000
* 00090000
* LICENSED MATERIALS - PROPERTY OF IBM 00100000
* 5615-DB2 00106000
* (C) COPYRIGHT 1982, 2013 IBM CORP. ALL RIGHTS RESERVED. 00113000
* 00120000
* STATUS = VERSION 11 00127000
* 00134000
* 00142000
* FUNCTION = THIS MODULE BUILDS A DEPARTMENT STRUCTURE, 00150000
* COMPOSED OF A SELECTED DEPARTMENT AND ITS 00160000
* SUBDEPARTMENTS AND EMPLOYEES. 00170000
* 00180000
* FOR DEPARTMENTS, THE MANAGERS ARE ALSO SHOWN. 00190000
* 00200000
* THE SELECTED DEPARTMENT CAN BE SPECIFIED 00210000
* IN SEVERAL WAYS: 00220000
* THROUGH A 'NEW' REQUEST 00230000
* . IT CAN BE SPECIFIED IN SECONDARY SELECTION 00240000
* . IT CAN BE ONLY IN SECONDARY SELECTION 00250000
* THROUGH A 'SCROLL' REQUEST 00260000
* . IT CAN BE THE SAME AS LAST TIME 00270000
* ('NEXT' FUNCTION) 00280000
* . IT CAN BE THE SUPERORDINATE DEPARTMENT 00290000
* OF THE LAST ONE ('LEFT' FUNCTION) 00300000
* 00310000
* NOTES = 00320000
* DEPENDENCIES = NONE 00330000
* RESTRICTIONS = THE VALID OPTIONS ARE: 00340000
* O - D - DS - DI,DN,MI,MN,EI,EN 00350000
* 00360000
* MODULE TYPE = 00370000
* PROCESSOR = DB2 PRECOMPILER, COBOL COMPILER 00380000
* MODULE SIZE = SEE LINK-EDIT 00390000
* ATTRIBUTES = REUSABLE 00400000
* 00410000
* ENTRY POINT = DSN8MCD 00420000
* PURPOSE = SEE FUNCTION 00430000
* LINKAGE = MODULE CALLED BY DSN8MCA 00440000
* 00450000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: 00460000
* COMMON AREA. 00470000
* 00480000
* SYMBOLIC LABEL/NAME = PCONVSTA.MAXSEL 00490000
* DESCRIPTION = NUMBER OF SELECTIONS 00500000
* 00510000
* SYMBOLIC LABEL/NAME = COMPARM .NEWREQ 00520000
* DESCRIPTION = Y-NEW REQUEST 00530000
* N-OLD REQUEST 00540000
* 00550000
* SYMBOLIC LABEL/NAME = OUTAREA .OUTPUT 00560000
* DESCRIPTION = SECONDARY SELECTION OUTPUT 00570000
* OR 'LAST TIME' DETAIL OUTPUT 00580000
* 00590000
* SYMBOLIC LABEL/NAME = LASTPOS.MPDSAVE 00600000
* DESCRIPTION = SAVED DATA FROM 'LAST TIME' 00610000
* 00620000
* SYMBOLIC LABEL/NAME = INAREA 00630000
* DESCRIPTION = USER INPUT 00640000
* 00650000
* 00660000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: 00670000
* COMMON AREA. 00680000
* 00690000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV 00700000
* DESCRIPTION = 'D' 00710000
* 00720000
* SYMBOLIC LABEL/NAME = OUTAREA .OUTPUT 00730000
* DESCRIPTION = SCREEN DETAIL OUTPUT 00740000
* 00750000
* 00760000
* EXIT-NORMAL = 00770000
* 00780000
* EXIT-ERROR = 00790000
* 00800000
* RETURN CODE = NONE 00810000
* 00820000
* ABEND CODES = NONE 00830000
* 00840000
* 00850000
* ERROR-MESSAGES = 00860000
* DSN8018I 'CURRENT' DEPARTMENT NOT FOUND 00870000
* DSN8019E NO 'HIGHER' DEPARTMENT EXISTS 00880000
* DSN8056I NO MORE DATA TO DISPLAY 00890000
* DSN8066E UNSUPPORTED PFK OR LOGIC ERROR 00900000
* DSN8070E VITAL DATA IS MISSING IN TABLE 00910000
* 'TOPTVAL' 00920000
* DSN8073E SPECIFIED LINE-NUMBER NOT FOUND IN 00930000
* PREVIOUS SCREEN 00940000
* 00950000
* EXTERNAL REFERENCES = 00960000
* ROUTINES/SERVICES = 00970000
* DSN8MCG = ERROR MESSAGE ROUTINE 00980000
* 00990000
* DATA-AREAS = 01000000
* DSN8MCDP = DCLGEN FOR VDEPT - DEPARTMENT TABLE 01010000
* DSN8MCAD = DCLGEN FOR VASTRDET - DEPARTMENT STRUCT TABLE 01020000
* DSN8MCOV = DCLGEN FOR VOPTVAL - OPTIONS VALIDATION TABLE 01030000
* DSN8MCDT = DCLGEN FOR VDSPTXT - DISPLAY AREA TEXT TABLE 01040000
* DSN8MCCA = SAMPLE APPLICATION COMMUNICATIONS AREA 01050000
* DSN8MCDH = CURSOR FOR DISPLAY AREA TEXT 01060000
* DSN8MCDA = CURSOR FOR DEPARTMENT STRUCTURE 01070000
* 01080000
* CONTROL-BLOCKS = 01090000
* SQLCA = SQL COMMUNICATION AREA 01100000
* 01110000
* TABLES = NONE 01120000
* 01130000
* 01140000
* CHANGE-ACTIVITY = NONE 01150000
* 01160000
* 01170000
* *PSEUDOCODE* 01180000
* 01190000
* PROCEDURE 01200000
* 01210000
* MAIN PROCESSING. 01220000
* SQL-GET TEXTLINES (HEADER, INFO AND PFK) FROM TABLE VOPTVAL01230000
* IF NOT FOUND, ERROR('070E') 01240000
* IF NEW REQUEST THEN 01250000
* IF MAX SELECTION IS 1 THEN SELECTED-LINE = '01' 01260000
* ELSE GET SELECTED-LINE FROM INPUT DATA 01270000
* FIND SELECTED DEPARTMENT IN PREVIOUS SCREEN 01280000
* IF NOT FOUND, ERROR('073E') 01290000
* SQL-FETCH DISPLAY AREA HEADER LINES FROM VDSPTXT USING DH 01300000
* IF NEW REQUEST THEN 01310000
* CLEAR SAVED SCROLLING LIMITS 01320000
* CALL BUILD-DISPLAY-ASCENDING 01330000
* ELSE 01340000
* FIND SELECTED DEPARTMENT IN PREVIOUS SCREEN 01350000
* SELECT PFK VALUE 01360000
* WHEN('08' OR 'NEXT') CALL BUILD-DISPLAY-ASCENDING 01370000
* WHEN('10' OR 'LEFT') CALL PREPARE-LEFT 01380000
* OTHERWISE ERROR('066E') 01390000
* RETURN TO CALLER (OF DSN8MCD) 01400000
* 01410000
* 01420000
* ERROR AND MESSAGE HANDLER. 01430000
* SQL-GET MESSAGE TEXT FROM DSN8MCG FOR GIVEN ARGUMENT 01440000
* IF NOT FOUND, BUILD MESSAGE TEXT 01450000
* RETURN TO CALLER (OF DSN8MCD) 01460000
* 01470000
* PREPARE-LEFT. 01480000
* SQL-GET 'HIGHER' DEPARTMENT FOR 'CURRENT' DEPARTMENT 01490000
* FROM TABLE VDEPT 01500000
* IF 'CURRENT' NOT FOUND, ERROR('018I') 01510000
* IF NO 'HIGHER', MESSAGE('019E') 01520000
* MAKE 'HIGHER' DEPARTMENT 'CURRENT' 01530000
* RETURN TO CALLER 01540000
* 01550000
* BUILD-DISPLAY-ASCENDING. 01560000
* SQL-OPEN CURSOR DAA 01570000
* DO WHILE(MORE DATA AND THERE IS ROOM IN DISPLAY AREA) 01580000
* SQL-FETCH INTO PASTRDET USING DAA 01590000
* IF FIRST TIME 01600000
* CLEAR DISPLAY AREA (EXCEPT HEADERS) 01610000
* PUT 'CURRENT' DEPARTMENT AND MANAGER ON LEFT SIDE 01620000
* SAVE LIMIT VALUE FOR NEXT TIME SCROLLING 01630000
* SELECT RECORD TYPE 01640000
* WHEN('1') PUT DEPARTMENT,MANAGER AND MOVE CURRENT LINE01650000
* WHEN('2') PUT EMPLOYEE AND MOVE CURRENT LINE 01660000
* WHEN('3') MOVE CURRENT LINE TO BOTTOM LINE (TERMINATE)01670000
* END 01680000
* IF NO DATA FOUND, MESSAGE('056I') 01690000
* SAVE LIMIT VALUE FOR NEXT TIME SCROLLING 01700000
* IF TWO LINES REMAIN IN DISPLAY AREA, 01710000
* SQL-FETCH INTO PASTRDET USING DAA 01720000
* IF RECORD TYPE IS '2', PUT EMPLOYEE AND SAVE LIMIT VALUE 01730000
* SQL-CLOSE CURSOR DAA 01740000
* RETURN TO CALLER 01750000
* 01760000
* END. 01770000
*---------------------------------------------------------------**01780000
**************************************************************** 01790000
* DETAIL - ADMINISTRATIVE STRUCTURE * 01800000
**************************************************************** 01810000
01820000
DSN8MCD. 01830000
01840000
MOVE 'DSN8MCD' TO MAJOR IN DSN8-MODULE-NAME. 01850000
MOVE SPACE TO MINOR IN DSN8-MODULE-NAME. 01860000
* 01870000
**************************************************************** 01880000
* ** INITIALIZE CONTROL FIELD TO DETAIL HANDLER 01890000
**************************************************************** 01900000
MOVE 'D' TO PREV IN PCONVSTA. 01910000
01920000
**************************************************************** 01930000
* ** RETRIEVE HEADING LINE, PFKEY DESCRIPTION, AND MESSAGE 01940000
**************************************************************** 01950000
EXEC SQL SELECT * 01960000
INTO :POPTVAL 01970000
FROM VOPTVAL 01980000
WHERE MAJSYS = :INAREA.MAJSYS 01990000
AND ACTION = :INAREA.ACTION 02000000
AND OBJFLD = :INAREA.OBJFLD 02010004
AND SCRTYPE = 'D' END-EXEC. 02020000
* 02030000
* ** IF SOME VITAL DATA IS MISSING IN 02040000
* ** THE TABLE 'VOPTVAL' 02050000
* **PRINT ERROR MESSAGE 02060000
IF SQLCODE NOT = 0 THEN 02070000
MOVE '070E' TO MSGCODE 02080000
GO TO ERROR-HANDLER. 02090000
02100000
**************************************************************** 02110000
* ** PUT DATA IN THE SCREEN 02120000
**************************************************************** 02130000
MOVE 'DSN8001' TO LASTSCR IN PCONVSTA. 02140000
MOVE HEADTXT IN POPTVAL TO HTITLE IN OUTAREA. 02150000
MOVE INFOTXT IN POPTVAL TO MSG IN OUTAREA. 02160000
MOVE PFKTXT IN POPTVAL TO PFKTEXT IN OUTAREA. 02170000
02180000
MOVE 15 TO BOTLINE. 02190000
02200000
**************************************************************** 02210000
* ** DETERMINE IF NEW REQUEST 02220000
* ** IF SO, PREVIOUS REQUEST WAS SECONDARY SEL 02230000
**************************************************************** 02240000
02250000
* **OLD REQUEST 02260000
IF NEWREQ IN COMPARM NOT = 'Y' THEN GO TO MCD-50. 02270000
02280000
* **NEW REQUEST 02290000
IF MAXSEL IN PCONVSTA = 1 THEN 02300000
* **SPECIFIED 02310000
* **LINE NO. = '01' 02320000
MOVE '01' TO LINE-SELECT-C 02330000
ELSE 02340000
* **GET SPECIFIED 02350000
* **LINE NO.FROM 02360000
* **INPUT DATA 02370000
MOVE SPACE TO DATAOUT IN OUTAREA 02380000
MOVE LINE-SEL IN INAREA TO LINE-SELECT-C. 02390000
* 02400000
MOVE 1 TO I. 02410000
02420000
MCD-10. 02430000
* ** IF THE SPECIFIED LINE NO. WAS NOT 02440000
* ** FOUND IN THE PREVIOUS SCREEN 02450000
* ** PRINT ERROR MESSAGE 02460000
IF I > 13 THEN 02470000
MOVE '073E' TO MSGCODE 02480000
GO TO ERROR-HANDLER 02490000
ELSE 02500000
* **FIND SELECTED DEPARTMENT 02510000
* **IN PREVIOUS SCREEN 02520000
IF LINE-SELECT-P NOT = LINENO IN BGMC1(I) THEN 02530000
ADD 1 TO I 02540000
GO TO MCD-10. 02550000
02560000
MCD-20. 02570000
MOVE DEPTNUM IN BGMC1(I) TO DEPT1NO IN PASTRDET. 02580000
MCD-50. 02590000
**************************************************************** 02600000
* ** USING THE SQL-CURSOR 'DH' 02610000
* **GET HEADING LINES FOR DISPLAY AREA 02620000
**************************************************************** 02630000
02640000
* **OPEN DH CURSOR 02650000
EXEC SQL OPEN DH END-EXEC. 02660000
* 02670000
MOVE 1 TO I. 02680000
MCD-60. 02690000
* **GET HEATING LINES 02700000
IF I NOT > BOTLINE THEN 02710000
EXEC SQL FETCH DH 02720000
INTO :PDSPTXT.DSPLINE, :PDSPTXT.LINENO END-EXEC 02730000
IF SQLCODE = 0 THEN 02740000
MOVE DSPLINE TO LINE0(I) 02750000
ADD 1 TO I 02760000
GO TO MCD-60. 02770000
* **CLOSE DH CURSOR 02780000
EXEC SQL CLOSE DH END-EXEC. 02790000
02800000
MOVE I TO TOPLINE. 02810000
* 02820000
IF NEWREQ IN COMPARM = 'Y' THEN 02830000
02840000
* ** THIS IS A NEW REQUEST, SO MAKE 02850000
* ** SURE WE DON'T LIMIT OUR SEARCH 02860000
02870000
MOVE LOW-VALUE TO T2MIN IN MPDSAVE 02880000
MOVE LOW-VALUE TO D2MIN IN MPDSAVE 02890000
MOVE LOW-VALUE TO E2MIN IN MPDSAVE 02900000
02910000
* ** BUILD DISPLAY AREA 02920000
02930000
PERFORM BUILD-DISPLAY-ASCENDING 02940000
THRU END-BUILD-DISPLAY-ASCENDING 02950000
02960000
* **RETURN TO CALLER 02970000
GO TO END-DSN8MCD. 02980000
02990000
* ** THIS IS AN ANSWER (SHOULD BE A 03000000
* ** SCROLL REQUEST) SO WE SAVE THE 03010000
* ** CURRENT 'LEFT-SIDE' DEPARTMENT 03020000
* ** FROM THE PREVIOUS SCREEN 03030000
03040000
MOVE D1NO IN LEFT-DPT(TOPLINE) TO DEPT1NO IN PASTRDET. 03050000
03060000
* ** DETERMINE THE SCROLL REQUEST 03070000
* ** AND CALL CORRESPONDING ROUTINE 03080000
03090000
* **PFKEY 08 OR NEXT 03100000
IF PFKIN IN INAREA = '08' OR 03110000
DATAIN IN INAREA = 'NEXT' THEN 03120000
PERFORM BUILD-DISPLAY-ASCENDING 03130000
THRU END-BUILD-DISPLAY-ASCENDING 03140000
GO TO END-DSN8MCD. 03150000
* **PFKEY 10 OR LEFT 03160000
IF PFKIN IN INAREA = '10' OR 03170000
DATAIN IN INAREA = 'LEFT' THEN 03180000
PERFORM PREPARE-LEFT THRU END-PREPARE-LEFT 03190000
ELSE 03200000
03210000
* ** UNSUPPORTED PFK OR LOGIC ERROR 03220000
* ** PRINT ERROR MESSAGE 03230000
03240000
MOVE '066E' TO MSGCODE 03250000
GO TO ERROR-HANDLER. 03260000
* ** RETURN 03270000
END-DSN8MCD. 03280000
* 03290000
**************************************************************** 03300000
* **GET THE 'HIGHER' DEPARTMENT FOR 'CURRENT' DEPARTMENT 03310000
* **FROM TABLE VDEPT 03320000
**************************************************************** 03330000
PREPARE-LEFT. 03340000
MOVE 'PREPLEFT' TO MINOR IN DSN8-MODULE-NAME. 03350000
03360000
* **GET INFO. FROM TABLE 03370000
EXEC SQL SELECT DEPTNO, ADMRDEPT 03380000
INTO :PDEPT.DEPTNO, 03386000
:PDEPT.ADMRDEPT 03393000
FROM VDEPT 03400000
WHERE DEPTNO = :PASTRDET.DEPT1NO END-EXEC. 03410000
03420000
* **'CURRENT' DEPARTMENT NOT FOUND 03430000
* **PRINT ERROR MESSAGE 03440000
03450000
IF SQLCODE NOT = 0 THEN 03460000
MOVE '018I' TO MSGCODE 03470000
GO TO ERROR-HANDLER. 03480000
03490000
* **MAKE 'HIGHER' 03500000
* **DEPARTMENT 'CURRENT' 03510000
03520000
IF ADMRDEPT IN PDEPT NOT = DEPTNO IN PDEPT THEN 03530000
MOVE ADMRDEPT IN PDEPT TO DEPT1NO IN PASTRDET 03540000
MOVE LOW-VALUE TO T2MIN IN MPDSAVE 03550000
MOVE LOW-VALUE TO D2MIN IN MPDSAVE 03560000
MOVE LOW-VALUE TO E2MIN IN MPDSAVE 03570000
03580000
* **BUILD DISPLAY AREA 03590000
PERFORM BUILD-DISPLAY-ASCENDING 03600000
THRU END-BUILD-DISPLAY-ASCENDING 03610000
ELSE 03620000
03630000
* **NO 'HIGHER' DEPARTMENT EXISTS 03640000
* **PRINT ERROR MESSAGE 03650000
MOVE '019E' TO MSGCODE 03660000
GO TO ERROR-HANDLER. 03670000
* 03680000
END-PREPARE-LEFT. 03690000
* 03700000
* 03710000
**************************************************************** 03720000
* **BUILD DISPLAY AREA 03730000
**************************************************************** 03740000
BUILD-DISPLAY-ASCENDING. 03750000
* 03760000
MOVE 'BUILD-A' TO MINOR IN DSN8-MODULE-NAME. 03770000
03780000
* **OPEN DAA CURSOR 03790000
EXEC SQL OPEN DAA END-EXEC. 03800000
* 03810000
MOVE TOPLINE TO CURRLINE. 03820000
* ** WE WILL SELECT DATA AS LONG AS 03830000
* ** THERE IS ROOM IN DISPLAY AREA 03840000
MCD-200. 03850000
IF CURRLINE NOT < (BOTLINE - 1) OR 03860000
SQLCODE NOT = 0 THEN GO TO MCD-300. 03870000
* 03880000
MOVE SPACES TO PASTRDET. 03890000
* 03900000
EXEC SQL FETCH DAA 03910000
INTO :PASTRDET:NULLARRY1 END-EXEC. 03920000
* 03930000
IF SQLCODE NOT = 0 THEN GO TO MCD-300. 03940000
03950000
* ** WE HAVE FOUND SOME DATA 03960000
PERFORM CHECK-FOR-NULLS 03970000
THRU END-CHECK-FOR-NULLS. 03973000
* 03976000
IF CURRLINE NOT = TOPLINE THEN GO TO MCD-280. 03980000
03990000
MOVE TOPLINE TO I. 04000000
**************************************************************** 04010000
* **THIS ROUTINE IS ONLY PERFORMED THE FIRST TIME AND IT... 04020000
* ** CLEARS THE DISPLAY AREA 04030000
* **PUTS LEFT SIDE DEPARTMENT AND MANAGER IN PLACE 04040000
* **SAVES DATA FOR FUTURE SCROLLING 04050000
**************************************************************** 04060000
MCD-210. 04070000
* **CLEARS DISPLAY AREA 04080000
IF I NOT > BOTLINE THEN 04090000
MOVE SPACE TO LINE0 IN OUTAREA(I) 04100000
ADD 1 TO I 04110000
GO TO MCD-210. 04120000
04130000
MOVE CURRLINE TO CURRL-1. 04140000
ADD +1 TO CURRL-1. 04150000
04160000
* **PUTS LEFT SIDE DEPARTMENT 04170000
* **& MANAGER IN PLACE 04180000
04190000
MOVE DEPT1NO IN PASTRDET TO D1NO IN LEFT-DPT(CURRLINE). 04200000
MOVE DEPT1NAM-TEXT IN PASTRDET 04210000
TO D1NA IN LEFT-DPT(CURRLINE). 04220000
MOVE EMP1NO IN PASTRDET TO M1NO IN LEFT-MGR(CURRL-1). 04230000
* 04240000
* **SAVES LIMITED VALUES 04250000
* **FOR NEXT TIME SCROLLING 04260000
04270000
IF EMP1MI IN PASTRDET = SPACE THEN 04280000
STRING EMP1FN-TEXT IN PASTRDET SPACE, 04290000
EMP1LN-TEXT IN PASTRDET DELIMITED BY SIZE 04300000
INTO M1NA IN LEFT-MGR(CURRL-1) 04310000
ELSE 04320000
STRING EMP1FN-TEXT IN PASTRDET SPACE, 04330000
EMP1MI IN PASTRDET SPACE, 04340000
EMP1LN-TEXT IN PASTRDET DELIMITED BY SIZE 04350000
INTO M1NA IN LEFT-MGR(CURRL-1). 04360000
**************************************************************** 04370000
* ** IF '1'- RIGHT SIDE IS DEPARTMENT 04380000
* **PUT DEPARTMENT & MANAGER ON TWO LINES 04390000
* **MAKE THIRD LINE BLANK 04400000
**************************************************************** 04410000
MCD-280. 04420000
IF TYPE2-TEXT IN PASTRDET NOT = '1' THEN 04430000
GO TO MCD-290. 04440000
04450000
* ** PUT DEPARTMENT 04460000
04470000
MOVE DEPT2NO IN PASTRDET TO D2NO IN RIGHT-DPT(CURRLINE). 04480000
MOVE DEPT2NAM-TEXT IN PASTRDET TO D2NA 04490000
IN RIGHT-DPT(CURRLINE). 04500000
04510000
* ** PUT MANAGER 04520000
04530000
MOVE EMP2NO IN PASTRDET TO M2NO IN RIGHT-MGR(CURRL-1). 04540000
* 04550000
IF EMP2MI IN PASTRDET = SPACE THEN 04560000
STRING EMP2FN-TEXT IN PASTRDET SPACE, 04570000
EMP2LN-TEXT IN PASTRDET DELIMITED BY SIZE 04580000
INTO M2NA IN RIGHT-MGR(CURRL-1) 04590000
ELSE 04600000
STRING EMP2FN-TEXT IN PASTRDET SPACE, 04610000
EMP2MI IN PASTRDET SPACE, 04620000
EMP2LN-TEXT IN PASTRDET DELIMITED BY SIZE 04630000
INTO M2NA IN RIGHT-MGR(CURRL-1). 04640000
04650000
* ** MAKE THIRD LINE BLANK 04660000
04670000
ADD +3 TO CURRLINE. 04680000
ADD +3 TO CURRL-1. 04690000
GO TO MCD-200. 04700000
04710000
**************************************************************** 04720000
* **IF '2'- RIGHT SIDE IS EMPLOYEE 04730000
* **PUT EMPLOYEE ON ONE LINE 04740000
* **MAKE SECOND LINE BLANK 04750000
**************************************************************** 04760000
MCD-290. 04770000
IF TYPE2-TEXT IN PASTRDET NOT = '2' THEN 04780000
GO TO MCD-200. 04790000
04800000
* **PUT EMPLOYEE 04810000
04820000
MOVE EMP2NO IN PASTRDET TO E2NO IN RIGHT-EMP(CURRLINE). 04830000
IF EMP2MI IN PASTRDET = SPACE THEN 04840000
STRING EMP2FN-TEXT IN PASTRDET SPACE, 04850000
EMP2LN-TEXT IN PASTRDET DELIMITED BY SIZE 04860000
INTO E2NA IN RIGHT-EMP(CURRLINE) 04870000
ELSE 04880000
STRING EMP2FN-TEXT IN PASTRDET SPACE, 04890000
EMP2MI IN PASTRDET SPACE, 04900000
EMP2LN-TEXT IN PASTRDET DELIMITED BY SIZE 04910000
INTO E2NA IN RIGHT-EMP(CURRLINE). 04920000
04930000
* **MAKE SECOND LINE BLANK 04940000
04950000
ADD +2 TO CURRLINE. 04960000
ADD +2 TO CURRL-1. 04970000
04980000
GO TO MCD-200. 04990000
05000000
**************************************************************** 05010000
* **IF '3'- NO DATA FOUND 05020000
* ** MOVE CURRENT LINE TO BOTTOM LINE (TERMINATE) 05030000
**************************************************************** 05040000
MCD-300. 05050000
* **IF NO DATA FOUND, SETUP FOR NEXT 05060000
* **TIME SCROLLING 05070000
* **PRINT ERROR MESSAGE 05080000
IF CURRLINE = TOPLINE THEN 05090000
MOVE HIGH-VALUE TO T2MIN IN MPDSAVE 05100000
MOVE HIGH-VALUE TO D2MIN IN MPDSAVE 05110000
MOVE HIGH-VALUE TO E2MIN IN MPDSAVE 05120000
05130000
MOVE '056I' TO MSGCODE 05140000
GO TO ERROR-HANDLER. 05150000
05160000
* ** IF WE HAVE REACHED END OF SEARCH 05170000
* ** SAVE FOR NEXT TIME SCROLLING 05180000
05190000
IF SQLCODE NOT = 0 THEN 05200000
MOVE HIGH-VALUE TO T2MIN IN MPDSAVE 05210000
MOVE HIGH-VALUE TO D2MIN IN MPDSAVE 05220000
MOVE HIGH-VALUE TO E2MIN IN MPDSAVE 05230000
GO TO MCD-310. 05240000
* 05250000
MOVE TYPE2-TEXT IN PASTRDET TO T2MIN IN MPDSAVE. 05260000
MOVE DEPT2NO IN PASTRDET TO D2MIN IN MPDSAVE. 05270000
MOVE EMP2NO IN PASTRDET TO E2MIN IN MPDSAVE. 05280000
05290000
* **IF TWO LINES REMAIN IN 05300000
* **DISPLAY AREA AND NEXT 'ROW' 05310000
* **IS EMPLOYEE THEN WE WILL TRY 05320000
* **TO INSERT THAT DATA 05330000
05340000
IF CURRLINE NOT < BOTLINE THEN 05350000
EXEC SQL FETCH DAA 05360000
INTO :PASTRDET:NULLARRY1 END-EXEC 05370000
05380000
* **IF '2' PUT EMPLOYEE ON /05390000
* **CURRENT LINE /05400000
05410000
IF SQLCODE = 0 AND 05420000
TYPE2-TEXT IN PASTRDET = '2' THEN 05430000
PERFORM CHECK-FOR-NULLS 05433000
THRU END-CHECK-FOR-NULLS 05436000
MOVE EMP2NO IN PASTRDET TO E2NO IN RIGHT-EMP(CURRLINE)05440000
05450000
* **SAVE 'NEW' DATA FOR 'CURRENT' 05460000
* **DATA FOR NEXT SCROLLING 05470000
05480000
MOVE TYPE2-TEXT IN PASTRDET TO T2MIN IN MPDSAVE 05490000
MOVE DEPT2NO IN PASTRDET TO D2MIN IN MPDSAVE 05500000
MOVE EMP2NO IN PASTRDET TO E2MIN IN MPDSAVE 05510000
05520000
* **PUT EMPLOYEE 05530000
05540000
IF EMP2MI IN PASTRDET = SPACE THEN 05550000
STRING EMP2FN-TEXT SPACE, 05560000
EMP2LN-TEXT DELIMITED BY SIZE 05570000
INTO E2NA IN RIGHT-EMP(CURRLINE) 05580000
ELSE 05590000
STRING EMP2FN-TEXT IN PASTRDET SPACE, 05600000
EMP2MI IN PASTRDET SPACE, 05610000
EMP2LN-TEXT IN PASTRDET DELIMITED BY SIZE 05620000
INTO E2NA IN RIGHT-EMP(CURRLINE). 05630000
05640000
MCD-310. 05650000
* **CLOSE DAA CURSOR 05660000
EXEC SQL CLOSE DAA END-EXEC. 05670000
* **RETURN TO CALLER 05680000
END-BUILD-DISPLAY-ASCENDING. 05690000
* 05700000
CHECK-FOR-NULLS. 05710000
IF NULLARRY1(3) = -1 THEN 05711000
MOVE ' ' TO EMP1NO OF PASTRDET. 05712000
IF NULLARRY1(4) = -1 THEN 05713000
MOVE ' ' TO EMP1FN OF PASTRDET. 05714000
IF NULLARRY1(5) = -1 THEN 05715000
MOVE ' ' TO EMP1MI OF PASTRDET. 05716000
IF NULLARRY1(6) = -1 THEN 05717000
MOVE ' ' TO EMP1LN OF PASTRDET. 05718000
IF NULLARRY1(10) = -1 THEN 05719000
MOVE ' ' TO EMP2NO OF PASTRDET. 05720000
IF NULLARRY1(11) = -1 THEN 05721000
MOVE ' ' TO EMP2FN OF PASTRDET. 05722000
IF NULLARRY1(12) = -1 THEN 05723000
MOVE ' ' TO EMP2MI OF PASTRDET. 05724000
IF NULLARRY1(13) = -1 THEN 05725000
MOVE ' ' TO EMP2LN OF PASTRDET. 05726000
END-CHECK-FOR-NULLS. 05727000
* 05728000
**************************************************************** 05729000
* ** DISPLAYS MESSAGE AND ENDS PROGRAM 05730000
**************************************************************** 05740000
ERROR-HANDLER. 05750000
* 05760000
MOVE 'ERROR-H' TO MINOR IN DSN8-MODULE-NAME. 05770000
* 05780000
CALL 'DSN8MCG' USING MAJOR MSGCODE OUTMSG. 05790000
* 05800000
MOVE OUTMSG TO MSGTEXT IN MSG. 05810000
* 05820000
GO TO END-DSN8MCD. 05830000