DSN8MPD
THIS MODULE BUILDS A DEPARTMENT STRUCTURE, COMPOSED OF A SELECTED DEPARTMENT AND ITS SUBDEPARTMENTS AND EMPLOYEES.
DSN8MPD: /* DETAIL - DEPARTMENT STRUCTURE */00010000
PROC REORDER; 00020000
%SKIP(2);00030000
/********************************************************************* 00040000
* * 00050000
* MODULE NAME = DSN8MPD * 00060000
* * 00070000
* DESCRIPTIVE NAME = SAMPLE APPLICATION * 00080000
* DEPARTMENT STRUCTURE - DETAIL MODULE * 00090000
* PL/I * 00100000
* ORGANIZATION * 00110000
* * 00120000
* LICENSED MATERIALS - PROPERTY OF IBM * 00130000
* 5695-DB2 * 00140000
* (C) COPYRIGHT 1982, 1995 IBM CORP. ALL RIGHTS RESERVED. * 00150000
* * 00160000
* STATUS = VERSION 4 * 00170000
* * 00180000
* FUNCTION = THIS MODULE BUILDS A DEPARTMENT STRUCTURE, * 00190000
* COMPOSED OF A SELECTED DEPARTMENT AND ITS * 00200000
* SUBDEPARTMENTS AND EMPLOYEES. * 00210000
* * 00220000
* FOR DEPARTMENTS, THE MANAGERS ARE ALSO SHOWN. * 00230000
* * 00240000
* THE SELECTED DEPARTMENT CAN BE SPECIFIED * 00250000
* IN SEVERAL WAYS: * 00260000
* THROUGH A 'NEW' REQUEST * 00270000
* . IT CAN BE SPECIFIED IN SECONDARY SELECTION * 00280000
* . IT CAN BE THE ONLY IN SECONDARY SELECTION * 00290000
* THROUGH A 'SCROLL' REQUEST * 00300000
* . IT CAN BE THE SAME AS LAST TIME * 00310000
* ('NEXT' FUNCTION) * 00320000
* . IT CAN BE THE SUPERORDINATE DEPARTMENT * 00330000
* OF THE LAST ONE ('LEFT' FUNCTION) * 00340000
* * 00350000
* NOTES = * 00360000
* DEPENDENCIES = NONE * 00370000
* * 00380000
* RESTRICTIONS = THE VALID OPTIONS ARE: * 00390000
* O - D - DS - DI,DN,MI,MN,EI,EN * 00400000
* * 00410000
* * 00420000
* MODULE TYPE = * 00430000
* PROCESSOR = DB2 PRECOMPILER, PL/I OPTIMIZER * 00440000
* MODULE SIZE = SEE LINK-EDIT * 00450000
* ATTRIBUTES = REUSABLE * 00460000
* * 00470000
* ENTRY POINT = DSN8MPD * 00480000
* PURPOSE = SEE FUNCTION * 00490000
* LINKAGE = MODULE CALLED BY DSN8MPA * 00500000
* INPUT = PARAMETERS EXPLICITLY PASSED TO THIS FUNCTION: * 00510000
* COMMON AREA. * 00520000
* * 00530000
* SYMBOLIC LABEL/NAME = COMPARM .NEWREQ * 00540000
* DESCRIPTION = Y-NEW REQUEST * 00550000
* N-OLD REQUEST * 00560000
* * 00570000
* SYMBOLIC LABEL/NAME = OUTAREA .OUTPUT * 00580000
* DESCRIPTION = SECONDARY SELECTION OUTPUT * 00590000
* OR 'LAST TIME' DETAIL OUTPUT * 00600000
* * 00610000
* SYMBOLIC LABEL/NAME = INAREA * 00620000
* DESCRIPTION = USER INPUT * 00630000
* * 00640000
* SYMBOLIC LABEL/NAME = DSN8MP_POS.MPDSAVE * 00650000
* DESCRIPTION = SAVED DATA FROM 'LAST TIME' * 00660000
* * 00670000
* SYMBOLIC LABEL/NAME = PCONVSTA.MAXSEL * 00680000
* DESCRIPTION = NUMBER OF SELECTIONS * 00690000
* * 00700000
* OUTPUT = PARAMETERS EXPLICITLY RETURNED: * 00710000
* COMMON AREA. * 00720000
* * 00730000
* SYMBOLIC LABEL/NAME = PCONVSTA.PREV * 00740000
* DESCRIPTION = 'D' * 00750000
* * 00760000
* SYMBOLIC LABEL/NAME = OUTAREA .OUTPUT * 00770000
* DESCRIPTION = SCREEN DETAIL OUTPUT * 00780000
* * 00790000
* EXIT-NORMAL = * 00800000
* * 00810000
* * 00820000
* EXIT-ERROR = * 00830000
* * 00840000
* RETURN CODE = NONE * 00850000
* * 00860000
* ABEND CODES = NONE * 00870000
* * 00880000
* ERROR-MESSAGES = * 00890000
* DSN8018I 'CURRENT' DEPARTMENT NOT FOUND * 00900000
* DSN8019E NO 'HIGHER' DEPARTMENT EXISTS * 00910000
* DSN8056I NO MORE DATA TO DISPLAY * 00920000
* DSN8066E UNSUPPORTED PFK OR LOGIC ERROR * 00930000
* DSN8070E VITAL DATA IS MISSING IN TABLE * 00940000
* 'TOPTVAL' * 00950000
* DSN8073E SPECIFIED LINE-NUMBER NOT FOUND IN * 00960000
* PREVIOUS SCREEN * 00970000
* * 00980000
* EXTERNAL REFERENCES = * 00990000
* ROUTINES/SERVICES = * 01000000
* DSN8MPG = ERROR MESSAGE ROUTINE * 01010000
* * 01020000
* DATA-AREAS = * 01030000
* DSN8MPDP = DCLGEN FOR VDEPT - DEPARTMENT TABLE * 01040000
* DSN8MPAD = DCLGEN FOR VASTRDET - DEPARTMENT STRUCTURE TABLE * 01050000
* DSN8MPOV = DCLGEN FOR VOPTVAL - OPTIONS VALIDATION TABLE * 01060000
* DSN8MPDT = DCLGEN FOR VDSPTXT - DISPLAY AREA TEXT TABLE * 01070000
* DSN8MPDH = CURSOR FOR DISPLAY AREA TEXT * 01080000
* DSN8MPDA = CURSOR FOR DEPARTMENT STRUCTURE * 01090000
* DSN8MPCA = SAMPLE APPLICATION COMMUNICATIONS AREA * 01100000
* * 01110000
* CONTROL-BLOCKS = * 01120000
* SQLCA = SQL COMMUNICATION AREA * 01130000
* * 01140000
* * 01150000
* CHANGE-ACTIVITY = NONE * 01160000
* * 01170000
* * 01180000
* *PSEUDOCODE* * 01190000
* * 01200000
* PROCEDURE * 01210000
* MAIN PROCESSING. * 01220000
* SQL-GET TEXTLINES (HEADER, INFO AND PFK) FROM TABLE VOPTVAL * 01230000
* 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 DSN8MPD) * 01400000
* * 01410000
* ERROR AND MESSAGE HANDLER. * 01420000
* SQL-GET MESSAGE TEXT FROM DSN8MPG FOR GIVEN ARGUMENT * 01430000
* IF NOT FOUND, BUILD MESSAGE TEXT * 01440000
* RETURN TO CALLER (OF DSN8MPD) * 01450000
* * 01460000
* PREPARE-LEFT. * 01470000
* SQL-GET 'HIGHER' DEPARTMENT FOR 'CURRENT' DEPARTMENT * 01480000
* FROM TABLE VDEPT * 01490000
* IF 'CURRENT' NOT FOUND, ERROR('018I') * 01500000
* IF NO 'HIGHER', MESSAGE('019E') * 01510000
* MAKE 'HIGHER' DEPARTMENT 'CURRENT' * 01520000
* RETURN TO CALLER * 01530000
* * 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
* SELECT RECORD TYPE * 01630000
* WHEN('1') PUT DEPARTMENT,MANAGER AND MOVE CURRENT LINE * 01640000
* WHEN('2') PUT EMPLOYEE AND MOVE CURRENT LINE * 01650000
* END * 01660000
* IF NO DATA FOUND, MESSAGE('056I') * 01670000
* SAVE LIMIT VALUE FOR NEXT TIME SCROLLING * 01680000
* IF TWO LINES REMAIN IN DISPLAY AREA, * 01690000
* SQL-FETCH INTO PASTRDET USING DAA * 01700000
* IF RECORD TYPE IS '2', PUT EMPLOYEE AND SAVE LIMIT VALUE * 01710000
* SQL-CLOSE CURSOR DAA * 01720000
* RETURN TO CALLER * 01730000
* END. * 01740000
*___________________________________________________________________*/01750000
/********************************************************/ 01760000
/* ** FIELDS SENT TO MESSAGE ROUTINE */ 01770000
/********************************************************/ 01780000
01790000
DCL MODULE CHAR (07) INIT ('DSN8MPD'); 01800000
DCL OUTMSG CHAR (69); 01810000
%PAGE;01820000
DCL DSN8MPG EXTERNAL ENTRY; 01830000
01840000
/***************************************************************/ 01850000
/* BUILT-IN FUNCTIONS */ 01860000
/***************************************************************/ 01870000
01880000
DCL 01890000
(ADDR, 01900000
HBOUND, 01910000
HIGH, 01920000
LENGTH, 01930000
LOW, 01940000
SUBSTR) BUILTIN; 01950000
01960000
/***************************************************************/ 01970000
/* PROGRAM VARIABLES */ 01980000
/***************************************************************/ 01990000
02000000
DCL 02010000
TOPLINE FIXED BIN(31), /* TOP LINE ON SCREEN */ 02020000
BOTLINE FIXED BIN(31), /* BOTTOM LINE ON SCREEN */ 02030000
CURRLINE FIXED BIN(31), /* CURRENT LINE ON SCREEN */ 02040000
I FIXED BIN(31), 02050000
CURRLINE_PTR PTR, /* CURRENT LINE POINTER */ 02060000
NEXTLINE_PTR PTR, /* NEXT LINE POINTER */ 02070000
LINE_SELECT_C CHAR(2), 02080000
LINE_SELECT_P PIC'99' DEF LINE_SELECT_C; 02090000
%PAGE;02100000
02110000
/***************************************************************/ 02120000
/* FIVE OVERLAYS USED TO PLACE OUTPUT DATA CORRECT ON SCREEN */ 02130000
/***************************************************************/ 02140000
02150000
DCL 02160000
1 LEFT_DPT BASED(CURRLINE_PTR), /* LEFT DEPARTMENT */ 02170000
3 D1NO CHAR( 3), 02180000
3 X11 CHAR( 2), 02190000
3 D1NA CHAR(34); 02200000
%SKIP(2);02210000
DCL 02220000
1 LEFT_MGR BASED(NEXTLINE_PTR), /* LEFT MANAGER */ 02230000
3 X21 CHAR( 1), 02240000
3 M1NO CHAR( 6), 02250000
3 X22 CHAR( 2), 02260000
3 M1NA CHAR(30); 02270000
%SKIP(2);02280000
DCL 02290000
1 RIGHT_DPT BASED(CURRLINE_PTR), /* RIGHT DEPARTMENT */ 02300000
3 X12 CHAR(40), 02310000
3 D2NO CHAR( 3), 02320000
3 X13 CHAR( 2), 02330000
3 D2NA CHAR(34); 02340000
%SKIP(2);02350000
DCL 02360000
1 RIGHT_MGR BASED(NEXTLINE_PTR), /* RIGHT MANAGER */ 02370000
3 X23 CHAR(40), 02380000
3 X24 CHAR( 1), 02390000
3 M2NO CHAR( 6), 02400000
3 X25 CHAR( 2), 02410000
3 M2NA CHAR(30); 02420000
%SKIP(2);02430000
DCL 02440000
1 RIGHT_EMP BASED(CURRLINE_PTR), /* RIGHT EMPLOYEE */ 02450000
3 X14 CHAR(40), 02460000
3 E2NO CHAR( 6), 02470000
3 X15 CHAR( 2), 02480000
3 E2NA CHAR(30); 02490000
%PAGE;02500000
/***************************************************************/ 02510000
/* ** INITIALIZE CONTROL FIELD TO DETAIL HANDLER */ 02520000
/* ** INITIALIZE MODULE TO DSN8MPD */ 02530000
/***************************************************************/ 02540000
02550000
PCONVSTA.PREV = 'D'; /*INITIALIZE CONTROL FIELD*/ 02560000
DSN8_MODULE_NAME.MAJOR = 'DSN8MPD'; /*INITIALIZE MODULE NAME */ 02570000
DSN8_MODULE_NAME.MINOR = ''; /* CLEAR ROUTINE NAME */ 02580000
02590000
/*************************************************************/ 02600000
/* ** RETRIEVE HEADING LINE, PFKEY DESCRIPTION, AND MESSAGE */ 02610000
/*************************************************************/ 02620000
02630000
EXEC SQL SELECT * /* RETRIEVE INFORMATION */ 02640000
INTO :POPTVAL 02650000
FROM VOPTVAL 02660000
WHERE MAJSYS = :INAREA.MAJSYS 02670000
AND ACTION = :INAREA.ACTION 02680000
AND OBJFLD = :INAREA.OBJFLD 02690002
AND SCRTYPE = 'D'; 02700000
%SKIP(2);02710000
IF SQLCODE^=0 THEN 02720000
/* SOME VITAL DATA IS MISSING IN */ 02730000
/* THE PROGRAM RELATED TABLE */ 02740000
/* PRINT ERROR MESSAGE */ 02750000
DO; 02760000
CALL DSN8MPG (MODULE, '070E', OUTMSG); 02770000
CALL ERROR_HANDLER; /* WITHOUT RETURNING */ 02780000
END; 02790000
02800000
/*********************************************************/ 02810000
/* ** PUT DATA IN THE SCREEN */ 02820000
/*********************************************************/ 02830000
02840000
PCONVSTA.LASTSCR = 'DSN8001'; 02850000
PCONVSTA.TITLE = POPTVAL.HEADTXT; /* OBTAIN HEADING */ 02860000
PCONVSTA.MSG = POPTVAL.INFOTXT; /* OBTAIN MESSAGE INFO. */ 02870000
PCONVSTA.PFKTEXT = POPTVAL.PFKTXT; /* OBTAIN PFKEY INFO. */ 02880000
%PAGE;02890000
/* SET UP INDEX FOR THE BOTTOMLINE*/ 02900000
/* IN THE DISPLAY AREA */ 02910000
02920000
BOTLINE = HBOUND(PCONVSTA.LINE,1); 02930000
02940000
/*********************************************************/ 02950000
/* ** DETERMINE IF NEW REQUEST */ 02960000
/* ** IF SO, PREVIOUS REQUEST WAS SECONDARY SEL */ 02970000
/*********************************************************/ 02980000
02990000
IF COMPARM.NEWREQ='Y' THEN /* NEW REQUEST ? */ 03000000
DO; 03010000
03020000
IF PCONVSTA.MAXSEL=1 THEN 03030000
LINE_SELECT_C = '01'; /* SPECIFIED LINE NO. = '01'*/ 03040000
03050000
ELSE /* ELSE */ 03060000
/* GET SPECIFIED LINE NO. */ 03070000
/* FROM INPUT DATA */ 03080000
DO; 03090000
LINE_SELECT_C = SUBSTR(COMPARM.INAREA.DATA,1,2); 03100000
PCONVSTA.OUTAREA.DATA = ''; 03110000
END; 03120000
%SKIP(2);03130000
DO I=1 TO HBOUND(DSN8MP1_POS.LINENO,1); 03140000
IF LINE_SELECT_P = DSN8MP1_POS(I).LINENO THEN 03150000
LEAVE; 03160000
END; 03170000
%SKIP(2);03180000
IF I>HBOUND(DSN8MP1_POS.LINENO,1) THEN 03190000
03200000
/* THE SPECIFIED LINE NO. WAS NOT */ 03210000
/* FOUND IN THE PREVIOUS SCREEN */ 03220000
DO; /* PRINT ERROR MESSAGE */ 03230000
03240000
CALL DSN8MPG (MODULE, '073E', OUTMSG); 03250000
CALL ERROR_HANDLER; /* WITHOUT RETURNING */ 03260000
END; 03270000
%SKIP(2);03280000
/* SAVE SELECTED DEPARTMENT NUMBER*/ 03290000
03300000
PASTRDET.DEPT1NO = DSN8MP1_POS(I).DEPTNUM; 03310000
END; 03320000
%PAGE;03330000
/**********************************************************/ 03340000
/* ** USING THE SQL-CURSOR 'DH' */ 03350000
/* ** GET HEATING LINES FOR DISPLAY AREA */ 03360000
/**********************************************************/ 03370000
03380000
EXEC SQL OPEN DH; /* OPEN DH CURSOR */ 03390000
03400000
DO I=1 TO BOTLINE UNTIL(SQLCODE^=0); /* GET HEATING LINES */ 03410000
EXEC SQL FETCH DH 03420000
INTO :PDSPTXT.DSPLINE, :PDSPTXT.LINENO; 03430000
IF SQLCODE=0 THEN 03440000
PCONVSTA.LINE(I) = PDSPTXT.DSPLINE; 03450000
END; 03460000
03470000
EXEC SQL CLOSE DH; /* CLOSE DH CURSOR */ 03480000
03490000
/* TOPLINE IS THE FIRST AVAILABLE */ 03500000
TOPLINE = I; /* LINE IN THE DISPLAY AREA */ 03510000
%PAGE;03520000
IF COMPARM.NEWREQ='Y' THEN 03530000
03540000
/* THIS IS A NEW REQUEST, SO MAKE */ 03550000
/* SURE WE DON'T LIMIT OUT SEARCH */ 03560000
03570000
DO; 03580000
MPDSAVE.T2MIN = LOW(LENGTH(T2MIN)); 03590000
MPDSAVE.D2MIN = LOW(LENGTH(D2MIN)); 03600000
MPDSAVE.E2MIN = LOW(LENGTH(E2MIN)); 03610000
03620000
CALL BUILD_DISPLAY_ASCENDING; /* BUILD DISPLAY AREA */ 03630000
03640000
END; 03650000
ELSE 03660000
03670000
03680000
/* THIS IS AN ANSWER (SHOULD BE A */ 03690000
/* SCROLL REQUEST) SO WE SAVE THE */ 03700000
/* CURRENT 'LEFT-SIDE' DEPARTMENT */ 03710000
/* FROM THE PREVIOUS SCREEN */ 03720000
03730000
DO; 03740000
CURRLINE_PTR = ADDR(PCONVSTA.LINE(TOPLINE)); 03750000
PASTRDET.DEPT1NO = LEFT_DPT.D1NO; 03760000
03770000
/* DETERMINE THE SCROLL REQUEST */ 03780000
/* AND CALL CORRESPONDING ROUTINE */ 03790000
03800000
03810000
SELECT; 03820000
WHEN(COMPARM.PFKIN='08', /*PFKEY 8 OR NEXT*/ 03830000
SUBSTR(COMPARM.DATA,1,4)='NEXT') 03840000
CALL BUILD_DISPLAY_ASCENDING; 03850000
%SKIP(1);03860000
WHEN(COMPARM.PFKIN='10', /*PFKEY 10 OR LEFT*/ 03870000
SUBSTR(COMPARM.DATA,1,4)='LEFT') 03880000
CALL PREPARE_LEFT; 03890000
03900000
/* UNSUPPORTED PFK OR LOGIC ERROR */ 03910000
OTHERWISE /* PRINT ERROR MESSAGE */ 03920000
DO; 03930000
CALL DSN8MPG (MODULE,'066E', OUTMSG); 03940000
CALL ERROR_HANDLER; /* WITHOUT RETURNING */ 03950000
END; 03960000
END; 03970000
END; 03980000
%PAGE;03990000
/*************************************************************/ 04000000
/* ** GET THE 'HIGHER' DEPARTMENT FOR 'CURRENT' DEPARTMENT */ 04010000
/* ** FROM TABLE VDEPT */ 04020000
/*************************************************************/ 04030000
04040000
PREPARE_LEFT: 04050000
PROC REORDER; 04060000
DSN8_MODULE_NAME.MINOR = 'PREPLEFT'; /* GET ROUTINE NAME */ 04070000
04080000
EXEC SQL SELECT DEPTNO,ADMRDEPT /*GET INFO. FROM TABLE*/ 04090000
INTO :PDEPT.DEPTNO, 04100000
:PDEPT.ADMRDEPT 04110000
FROM VDEPT 04120000
WHERE DEPTNO=:PASTRDET.DEPT1NO; 04130000
04140000
/*CURRENT DEPARTMENT NOTFOUND*/ 04150000
IF SQLCODE^=0 THEN /*PRINT ERROR MESSAGE */ 04160000
DO; 04170000
CALL DSN8MPG (MODULE, '018I', OUTMSG); 04180000
CALL ERROR_HANDLER; /* WITHOUT RETURNING */ 04190000
END; 04200000
04210000
IF PDEPT.ADMRDEPT^=PDEPT.DEPTNO THEN/*MAKE HIGHER DEPT CURRENT*/ 04220000
DO; 04230000
PASTRDET.DEPT1NO = PDEPT.ADMRDEPT; 04240000
MPDSAVE.T2MIN = LOW(LENGTH(T2MIN)); 04250000
MPDSAVE.D2MIN = LOW(LENGTH(D2MIN)); 04260000
MPDSAVE.E2MIN = LOW(LENGTH(E2MIN)); 04270000
CALL BUILD_DISPLAY_ASCENDING; 04280000
END; 04290000
ELSE /*NO HIGHER DEPT EXISTS*/ 04300000
DO; /*PRINT ERROR MESSAGE */ 04310000
CALL DSN8MPG (MODULE, '019E', OUTMSG); 04320000
CALL ERROR_HANDLER; /* WITHOUT RETURNING */ 04330000
END; 04340000
END; /* END OF PREPARE_LEFT */ 04350000
%PAGE;04360000
/**********************************************************/ 04370000
/* ** BUILD DISPLAY AREA */ 04380000
/**********************************************************/ 04390000
04400000
BUILD_DISPLAY_ASCENDING: 04410000
PROC REORDER; 04420000
%SKIP(2);04430000
DSN8_MODULE_NAME.MINOR = 'BUILD_A'; /* GET ROUTINE NAME */ 04440000
%SKIP(2);04450000
EXEC SQL OPEN DAA; /* OPEN DAA CURSOR */ 04460000
%SKIP(2);04470000
CURRLINE = TOPLINE; 04480000
04490000
04500000
/* WE WILL SELECT DATA AS LONG AS */ 04510000
/* THERE IS ROOM IN DISPLAY AREA */ 04520000
04530000
DO WHILE( CURRLINE<BOTLINE-1 & SQLCODE=0 ); 04540000
%SKIP(2);04550000
EXEC SQL FETCH DAA 04560000
INTO :PASTRDET:NULL_ARRY1; 04570000
%SKIP(2);04580000
IF SQLCODE=0 THEN 04590000
04600000
/* WE HAVE FOUND SOME DATA SO WE */ 04610000
/* ADDRESS CURRENT AND NEXT LINES */ 04620000
04630000
DO; 04640000
IF NULL_ARRY1(3) = -1 THEN /* CHECK FOR NULL VALUES */ 04650000
PASTRDET.EMP1NO = ' '; 04660000
IF NULL_ARRY1(4) = -1 THEN 04670000
PASTRDET.EMP1FN = ' '; 04680000
IF NULL_ARRY1(5) = -1 THEN 04690000
PASTRDET.EMP1MI = ' '; 04700000
IF NULL_ARRY1(6) = -1 THEN 04710000
PASTRDET.EMP1LN = ' '; 04720000
IF NULL_ARRY1(10) = -1 THEN 04730000
PASTRDET.EMP2NO = ' '; 04740000
IF NULL_ARRY1(11) = -1 THEN 04750000
PASTRDET.EMP2FN = ' '; 04760000
IF NULL_ARRY1(12) = -1 THEN 04770000
PASTRDET.EMP2MI = ' '; 04780000
IF NULL_ARRY1(13) = -1 THEN 04790000
PASTRDET.EMP2LN = ' '; 04800000
%SKIP(1);04810000
CURRLINE_PTR = ADDR(PCONVSTA.LINE(CURRLINE)); 04820000
NEXTLINE_PTR = ADDR(PCONVSTA.LINE(CURRLINE+1)); 04830000
%SKIP(2);04840000
/*************************************************************/ 04850000
/* ** THIS ROUTINE IS ONLY PERFORMED THE FIRST TIME AND IT...*/ 04860000
/* ** CLEARS THE DISPLAY AREA */ 04870000
/* ** PUTS LEFT SIDE DEPARTMENT AND MANAGER IN PLACE */ 04880000
/* ** SAVES DATA FOR FUTURE SCROLLING */ 04890000
/*************************************************************/ 04900000
04910000
IF CURRLINE=TOPLINE THEN 04920000
DO; 04930000
04940000
DO I=TOPLINE TO BOTLINE; /*CLEARS DISPLAY AREA*/ 04950000
PCONVSTA.LINE(I) = ''; 04960000
END; 04970000
04980000
/*PUT LEFT SIDE DEPARTMENT*/ 04990000
/*& MANAGER IN PLACE */ 05000000
05010000
LEFT_DPT.D1NO = PASTRDET.DEPT1NO; 05020000
LEFT_DPT.D1NA = PASTRDET.DEPT1NAM; 05030000
LEFT_MGR.M1NO = PASTRDET.EMP1NO; 05040000
05050000
/*SAVES LIMITED VALUES FOR NEXT */ 05060000
/*TIME SCROLLING */ 05070000
05080000
IF PASTRDET.EMP1MI=' ' THEN 05090000
LEFT_MGR.M1NA = PASTRDET.EMP1FN||' '|| 05100000
PASTRDET.EMP1LN; 05110000
ELSE 05120000
LEFT_MGR.M1NA = PASTRDET.EMP1FN||' '|| 05130000
PASTRDET.EMP1MI||' '|| 05140000
PASTRDET.EMP1LN; 05150000
END; 05160000
%SKIP(2);05170000
/*********************************************************/ 05180000
/* ** IF '1'- RIGHT SIDE IS DEPARTMENT */ 05190000
/* ** PUT DEPARTMENT & MANAGER ON TWO LINES */ 05200000
/* ** MAKE THIRD LINE BLANK */ 05210000
/*********************************************************/ 05220000
SELECT( PASTRDET.TYPE2 ); 05230000
WHEN('1') 05240000
05250000
/* RIGHT SIDE IS DEPARTMENT SO PUT */ 05260000
/* IT AND ITS MANAGER ON TWO LINES */ 05270000
/* MAKE THIRD LINE 'BLANK' */ 05280000
05290000
DO; 05300000
RIGHT_DPT.D2NO = PASTRDET.DEPT2NO; 05310000
RIGHT_DPT.D2NA = PASTRDET.DEPT2NAM; 05320000
RIGHT_MGR.M2NO = PASTRDET.EMP2NO; 05330000
IF PASTRDET.EMP2MI=' ' THEN 05340000
RIGHT_MGR.M2NA = PASTRDET.EMP2FN||' '|| 05350000
PASTRDET.EMP2LN; 05360000
ELSE 05370000
RIGHT_MGR.M2NA = PASTRDET.EMP2FN||' '|| 05380000
PASTRDET.EMP2MI||' '|| 05390000
PASTRDET.EMP2LN; 05400000
CURRLINE = CURRLINE+3; 05410000
END; 05420000
%SKIP(2);05430000
/*************************************************************/ 05440000
/* ** IF '2'- RIGHT SIDE IS EMPLOYEE */ 05450000
/* ** PUT EMPLOYEE ON ONE LINE */ 05460000
/* ** MAKE SECOND LINE BLANK */ 05470000
/*************************************************************/ 05480000
WHEN('2') 05490000
05500000
/* RIGHT SIDE IS EMPLOYEE SO PUT */ 05510000
/* HIM/HER ON ONE LINE AND MAKE */ 05520000
/* NEXT LINE 'BLANK' */ 05530000
05540000
DO; 05550000
RIGHT_EMP.E2NO = PASTRDET.EMP2NO; 05560000
IF PASTRDET.EMP2MI= ' ' THEN 05570000
RIGHT_EMP.E2NA = PASTRDET.EMP2FN||' '|| 05580000
PASTRDET.EMP2LN; 05590000
ELSE 05600000
RIGHT_EMP.E2NA = PASTRDET.EMP2FN||' '|| 05610000
PASTRDET.EMP2MI||' '|| 05620000
PASTRDET.EMP2LN; 05630000
CURRLINE = CURRLINE+2; 05640000
END; 05650000
%SKIP(2);05660000
%SKIP(2);05670000
OTHERWISE; 05680000
END; 05690000
END; 05700000
END; 05710000
%SKIP(2);05720000
/****************************************************************/ 05730000
/* ** IF '3'- NO DATA FOUND */ 05740000
/* ** MOVE CURRENT LINE TO BOTTOM LINE (TERMINATE) */ 05750000
/****************************************************************/ 05760000
IF CURRLINE=TOPLINE THEN 05770000
05780000
/* NO DATA FOUND, SO SETUP */ 05790000
/* FOR NEXT TIME SCROLLING */ 05800000
/* GO AND GIVE ERROR-MESSAGE */ 05810000
05820000
DO; 05830000
MPDSAVE.T2MIN = HIGH(LENGTH(T2MIN)); 05840000
MPDSAVE.D2MIN = HIGH(LENGTH(D2MIN)); 05850000
MPDSAVE.E2MIN = HIGH(LENGTH(E2MIN)); 05860000
CALL DSN8MPG (MODULE, '056I', OUTMSG); 05870000
CALL ERROR_HANDLER; /* WITHOUT RETURNING */ 05880000
END; 05890000
%SKIP(2);05900000
IF SQLCODE^=0 THEN 05910000
05920000
/* WE HAVE REACHED END OF SEARCH */ 05930000
/* SAVE FOR NEXT TIME SCROLLING */ 05940000
05950000
DO; 05960000
MPDSAVE.T2MIN = HIGH(LENGTH(T2MIN)); 05970000
MPDSAVE.D2MIN = HIGH(LENGTH(D2MIN)); 05980000
MPDSAVE.E2MIN = HIGH(LENGTH(E2MIN)); 05990000
END; 06000000
%SKIP(2);06010000
ELSE 06020000
06030000
/* LAST DATA FOUND WILL BE SAVED */ 06040000
/* FOR NEXT TIME SCROLLING */ 06050000
06060000
DO; 06070000
MPDSAVE.T2MIN = PASTRDET.TYPE2; 06080000
MPDSAVE.D2MIN = PASTRDET.DEPT2NO; 06090000
MPDSAVE.E2MIN = PASTRDET.EMP2NO; 06100000
%SKIP(2);06110000
IF CURRLINE<=BOTLINE THEN 06120000
06130000
06140000
/* IF ONE LINE REMAINS IN DISPLAY */ 06150000
/* AREA AND NEXT 'ROW' IS EMPLOYEE */ 06160000
/* WE WILL TRY TO INSERT THAT DATA */ 06170000
06180000
DO; 06190000
%SKIP(2);06200000
EXEC SQL FETCH DAA 06210000
INTO :PASTRDET:NULL_ARRY1; 06220000
%SKIP(2);06230000
IF SQLCODE=0 & PASTRDET.TYPE2='2' THEN 06240000
06250000
06260000
/* RIGHT SIDE WAS AN EMPLOYEE SO */ 06270000
/* PUT HIM/HER ON CURRENT LINE */ 06280000
/* SAVE NEW DATA FOR NEXT SCROLLING*/ 06290000
06300000
DO; 06310000
/* CHECK FOR NULL VALUES */ 06320000
IF NULL_ARRY1(3) = -1 THEN 06330000
PASTRDET.EMP1NO = ' '; 06340000
IF NULL_ARRY1(4) = -1 THEN 06350000
PASTRDET.EMP1FN = ' '; 06360000
IF NULL_ARRY1(5) = -1 THEN 06370000
PASTRDET.EMP1MI = ' '; 06380000
IF NULL_ARRY1(6) = -1 THEN 06390000
PASTRDET.EMP1LN = ' '; 06400000
IF NULL_ARRY1(10) = -1 THEN 06410000
PASTRDET.EMP2NO = ' '; 06420000
IF NULL_ARRY1(11) = -1 THEN 06430000
PASTRDET.EMP2FN = ' '; 06440000
IF NULL_ARRY1(12) = -1 THEN 06450000
PASTRDET.EMP2MI = ' '; 06460000
IF NULL_ARRY1(13) = -1 THEN 06470000
PASTRDET.EMP2LN = ' '; 06480000
CURRLINE_PTR = ADDR(PCONVSTA.LINE(CURRLINE)); 06490000
RIGHT_EMP.E2NO = PASTRDET.EMP2NO; 06500000
IF PASTRDET.EMP2MI= ' ' THEN 06510000
RIGHT_EMP.E2NA = PASTRDET.EMP2FN||' '|| 06520000
PASTRDET.EMP2LN; 06530000
ELSE 06540000
RIGHT_EMP.E2NA = PASTRDET.EMP2FN||' '|| 06550000
PASTRDET.EMP2MI||' '|| 06560000
PASTRDET.EMP2LN; 06570000
MPDSAVE.T2MIN = PASTRDET.TYPE2; 06580000
MPDSAVE.D2MIN = PASTRDET.DEPT2NO; 06590000
MPDSAVE.E2MIN = PASTRDET.EMP2NO; 06600000
END; 06610000
END; 06620000
END; 06630000
%SKIP(2);06640000
EXEC SQL CLOSE DAA; /*CLOSE DAA CURSOR */ 06650000
%SKIP(2);06660000
END; /* OF PROCEDURE BUILD_DISPLAY_ASCENDING */ 06670000
%PAGE;06680000
/**********************************************************/ 06690000
/* ** GETS ERROR TEXT AND PRINTS ERROR MESSAGES */ 06700000
/**********************************************************/ 06710000
ERROR_HANDLER: PROC; 06720000
06730000
DSN8_MODULE_NAME.MINOR = 'ERROR_H'; /* GET ROUTINE NAME */ 06740000
06750000
/* MESSAGE TEXT FOUND */ 06760000
PCONVSTA.MSG = OUTMSG; /* PRINTE MESSAGE */ 06770000
06780000
%SKIP(2);06790000
DSN8_MODULE_NAME.MINOR = 'FINISHED'; /* FINISHED */ 06800000
%SKIP(2);06810000
END /*ERROR_HANDLER*/; 06820000
END DSN8MPD; 06830000