PowerExchange for CDC and Mainframe
- PowerExchange for CDC and Mainframe 10.5.6
- All Products
IDENTIFICATION DIVISION.PROGRAM-ID. UCPGCLSC. **************************************************** * GLOBAL CUSTOMER SUPPORT SAMPLE CLASS TEST * EXAMPLE COBOL PROGRAM CALLED VIA CALLPROG. * ***** ***** * USER EXITS ARE NOT SUPPORTED BY INFORMATICA * USER EXITS ARE USED AT THE CUSTOMERS OWN RISK* * * USING SYNTAX :- *CALLPROG('UCPGCLSC','UCPGCLSC','COBOL','VOID', * TEXT_FIELD,NUMBER1_FIELD)* * RECEIVES THE FOLLOWING ARGUMENTS :- * 1. NUMBER-ARGUMENTS - REQUIRED * THE NUMBER OF ARGUMENTS WHICH FOLLOW. * THE PROGRAM WILL EXIT SETTING A BAD RETURN CODE * IF THE NUMBER IS NOT WHAT IT EXPECTS. * * 2. FAILURE-CODE. - REQUIRED * AN INTEGER PASSED BACK TO THE CALLER TO INDICATE IF * PROCESSING WAS WAS NOT SUCCESSFUL. * THE FAILURE-CODE IS MONITORED * SO THAT ACTION CAN BE TAKEN TO HANDLE ERRORS. * * BECAUSE THE MVS COBOL LINKAGE TYPE ONLY SUPPORTS A * RETURN TYPE OF 'VOID', IT IS NECESSARY TO PASS IT * BACK AS A NORMAL FIELD WITH ITS ACCOMPANYING LENGTH. * (SEE CLLPRGL2 FOR HOW THE RETURN CODE CAN BE PASSED * USING A LINKAGE TYPE OF 'OS' RETURNING 'INT') * * 3. MESSAGE-BUFFER. - REQUIRED * AN ERROR INTO WHICH THE PROGRAM CAN PUT A MESSAGE * TO ACCOMPANY A NON-ZERO FAILURE CODE, INDICATING * THE REASON. * * 4. MESSAGE-BUFFER-LENGTH. - REQUIRED * THE LENGTH OF MESSAGE-BUFFER * * 5. TEXT-AREA. * THIS IS THE 5TH ARGUMENT TO CALLPROG DEFINED IN THE * NAVIGATOR EXPRESSIONS SCREEN. * IN THIS EXAMPLE, IT IS A FIELD CONTAINING A MAX OF 15 BYTES * * 6. TEXT-AREA-LENGTH. * THE LENGTH OF TEXT-AREA WHICH VARIES ACCORDING * TO THE ACTUAL FIELD LENGTH ON THE FILE. ** 7. CLASS-TYPE. * THIS IS THE 6TH ARGUMENT TO CALLPROG DEFINED IN THE * NAVIGATOR EXPRESSIONS SCREEN. * IN THIS EXAMPLE, IT IS A 1 BYTE CHARACTER FIELD WITH VALUES * S=SPACES, L=LOW-VALUES, H=HIGH-VALUES, A=ALPHABETIC, N=NUMERIC * * 8. CLASS-TYPE-LENGTH. * THE LENGTH OF FIELD CLASS-TYPE WHICH WILL ALWAYS * BE 1.**************************************************** * ENVIRONMENT DIVISION. * DATA DIVISION. WORKING-STORAGE SECTION. * 01 WS-DATE PIC X(6). 01 WS-TIME PIC X(8).01 WS-DATA. 05 WS-DATA15 PIC X(15). 01 WS-DATAL14 REDEFINES WS-DATA. 05 WS-DATA14 PIC X(14). 05 FILLER PIC X(01). 01 WS-DATAL13 REDEFINES WS-DATA. 05 WS-DATA13 PIC X(13). 05 FILLER PIC X(02). 01 WS-DATAL12 REDEFINES WS-DATA. 05 WS-DATA12 PIC X(12). 05 FILLER PIC X(03). 01 WS-DATAL11 REDEFINES WS-DATA. 05 WS-DATA11 PIC X(11). 05 FILLER PIC X(04). 01 WS-DATAL10 REDEFINES WS-DATA. 05 WS-DATA10 PIC X(10). 05 FILLER PIC X(05). 01 WS-DATAL09 REDEFINES WS-DATA. 05 WS-DATA09 PIC X(09). 05 FILLER PIC X(06). 01 WS-DATAL08 REDEFINES WS-DATA. 05 WS-DATA08 PIC X(08). 05 FILLER PIC X(07). 01 WS-DATAL07 REDEFINES WS-DATA. 05 WS-DATA07 PIC X(07). 05 FILLER PIC X(08). 01 WS-DATAL06 REDEFINES WS-DATA. 05 WS-DATA06 PIC X(06). 05 FILLER PIC X(09). 01 WS-DATAL05 REDEFINES WS-DATA. 05 WS-DATA05 PIC X(05). 05 FILLER PIC X(10). 01 WS-DATAL04 REDEFINES WS-DATA. 05 WS-DATA04 PIC X(04). 05 FILLER PIC X(11). 01 WS-DATAL03 REDEFINES WS-DATA. 05 WS-DATA03 PIC X(03). 05 FILLER PIC X(12). 01 WS-DATAL02 REDEFINES WS-DATA. 05 WS-DATA02 PIC X(02). 05 FILLER PIC X(13). 01 WS-DATAL01 REDEFINES WS-DATA. 05 WS-DATA01 PIC X(01). 05 FILLER PIC X(14).* LINKAGE SECTION.01 LK-NUMBER-ARGUMENTS PIC S9(9) COMP. 01 LK-FAILURE-CODE PIC S9(9) COMP. 01 LK-MESSAGE-BUFFER. 05 LK-MESSAGE-BUFFER-BYTE PIC X(1) OCCURS 1 TO 255 DEPENDING ON LK-MESSAGE-BUFFER-LENGTH. 01 LK-MESSAGE-BUFFER-LENGTH PIC S9(9) COMP. 01 LK-TEXT-AREA. 05 LK-TEXT-AREA-BYTE PIC X(1) OCCURS 15. 01 LK-TEXT-AREA-LENGTH PIC S9(9) COMP. 01 LK-CLASS PIC X. 01 LK-CLASS-LENGTH PIC S9(9) COMP. PROCEDURE DIVISION USING LK-NUMBER-ARGUMENTS LK-FAILURE-CODE LK-MESSAGE-BUFFER LK-MESSAGE-BUFFER-LENGTH LK-TEXT-AREA LK-TEXT-AREA-LENGTH LK-CLASS LK-CLASS-LENGTH . MAIN SECTION. 0100-MAIN. MOVE ZERO TO LK-FAILURE-CODE. MOVE ZERO TO LK-MESSAGE-BUFFER-LENGTH. ************************************************************** * EXIT FLAGGING AN ERROR IF THE WRONG NUMBER OF ARGUMENT PAIRS ************************************************************** IF LK-NUMBER-ARGUMENTS NOT = 2 DISPLAY 'UCPGCLSC:NUMBER-ARGUMENTS=' LK-NUMBER-ARGUMENTS ' (REQUIRED 2)' ' EXITTING WITH RC=401' MOVE 401 TO LK-FAILURE-CODE MOVE 'UCPGCLSC:NOT ENOUGH ARGUMENTS ' TO LK-MESSAGE-BUFFER GO TO 0900-MAIN-EXIT END-IF. *********************************************************************** * IF DATA PRESENT FIND LENGTH AND TEST CLASS *********************************************************************** * IF LK-TEXT-AREA-LENGTH = ZERO MOVE 'FIELD EMPTY' TO LK-MESSAGE-BUFFER MOVE 11 TO LK-MESSAGE-BUFFER-LENGTH MOVE 402 TO LK-FAILURE-CODE GO TO 0900-MAIN-EXIT ELSE IF LK-TEXT-AREA-LENGTH > +15 MOVE 'LENGTH > 15' TO LK-MESSAGE-BUFFER MOVE 11 TO LK-MESSAGE-BUFFER-LENGTH MOVE 403 TO LK-FAILURE-CODE GO TO 0900-MAIN-EXIT ELSE MOVE LK-TEXT-AREA TO WS-DATA END-IF. * MOVE SPACES TO LK-CLASS. MOVE +1 TO LK-CLASS-LENGTH. * 0100-CLASS15. * IF LK-TEXT-AREA-LENGTH < +15 GO TO 0100-CLASS14 END-IF. * IF WS-DATA ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS14. * IF LK-TEXT-AREA-LENGTH < +14 GO TO 0100-CLASS13 END-IF. * IF WS-DATA14 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA14 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA14 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA14 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA14 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS13. * IF LK-TEXT-AREA-LENGTH < +13 GO TO 0100-CLASS12 END-IF. * IF WS-DATA13 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA13 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA13 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA13 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA13 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS12. * IF LK-TEXT-AREA-LENGTH < +12 GO TO 0100-CLASS11 END-IF. * IF WS-DATA12 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA12 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA12 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA12 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA12 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS11. * IF LK-TEXT-AREA-LENGTH < +11 GO TO 0100-CLASS10 END-IF. * IF WS-DATA11 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA11 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA11 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA11 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA11 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS10. * IF LK-TEXT-AREA-LENGTH < +10 GO TO 0100-CLASS09 END-IF. * IF WS-DATA10 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA10 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA10 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA10 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA10 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS09. * IF LK-TEXT-AREA-LENGTH < +9 GO TO 0100-CLASS08 END-IF. * IF WS-DATA09 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA09 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA09 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA09 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA09 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS08. * IF LK-TEXT-AREA-LENGTH < +8 GO TO 0100-CLASS07 END-IF. * IF WS-DATA08 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA08 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA08 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA08 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA08 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS07. * IF LK-TEXT-AREA-LENGTH < +7 GO TO 0100-CLASS06 END-IF. * IF WS-DATA07 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA07 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA07 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA07 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA07 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS06. * IF LK-TEXT-AREA-LENGTH < +6 GO TO 0100-CLASS05 END-IF. * IF WS-DATA06 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA06 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA06 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA06 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA06 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS05. * IF LK-TEXT-AREA-LENGTH < +5 GO TO 0100-CLASS04 END-IF. * IF WS-DATA05 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA05 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA05 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA05 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA05 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS04. * IF LK-TEXT-AREA-LENGTH < +4 GO TO 0100-CLASS03 END-IF. * IF WS-DATA04 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA04 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA04 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA04 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA04 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS03. * IF LK-TEXT-AREA-LENGTH < +3 GO TO 0100-CLASS02 END-IF. * IF WS-DATA03 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA03 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA03 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA03 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA03 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS02. * IF LK-TEXT-AREA-LENGTH < +2 GO TO 0100-CLASS01 END-IF. * IF WS-DATA02 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA02 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA02 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA02 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA02 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * 0100-CLASS01. * IF LK-TEXT-AREA-LENGTH < +1 GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA01 ALPHABETIC MOVE 'A' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA01 NUMERIC MOVE 'N' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA01 = LOW-VALUES MOVE 'L' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA01 = HIGH-VALUES MOVE 'H' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. * IF WS-DATA01 = SPACES MOVE 'S' TO LK-CLASS GO TO 0900-MAIN-EXIT END-IF. GO TO 0900-MAIN-EXIT. * * 0900-MAIN-EXIT. GOBACK.