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.
