-ADD COBV0ERR,PSWD=40EF,ARC,SEQ=/1,6,100,100/
-DESC LIST POTENTIAL COBOL-LE ERRORS
-PGMR STEVE RYDER, JSR SYSTEMS
-LANG COB
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.     COBV0ERR.
000300*AUTHOR.         STEVE RYDER JSR SYSTEMS.
000400 DATE-WRITTEN.   JULY 11, 1997.
000500 DATE-COMPILED.
000600*REMARKS.
000700*    IDENTIFY POTENTIAL ERRORS, PRINT 3 LINES (BEFORE, #, AFTER)
000800*
000900 ENVIRONMENT DIVISION.
001000 INPUT-OUTPUT SECTION.
001100 FILE-CONTROL.
001200     SELECT  SYSIPT-FILE
001300         ASSIGN TO  SYS016-COBIPT.
001400 DATA DIVISION.
001500 FILE    SECTION.
001600 FD  SYSIPT-FILE
001700     LABEL RECORDS ARE   STANDARD
001800     RECORDING MODE IS   F
001900     RECORD CONTAINS 80  CHARACTERS
002000     BLOCK CONTAINS  1   RECORDS
002100     DATA RECORD IS  SYSIPT-REC.
002200 01  SYSIPT-REC.
002300     05  SYSIPT-NUM.
002400         10  SYSIPT-CBL          PIC X(05).
002500         10  FILLER              PIC X(01).
002600     05  SYSIPT-COMMENT          PIC X(01).
002700     05  SYSIPT-MARGIN-A         PIC X(04).
002800     05  SYSIPT-MARGIN-B         PIC X(61).
002900     05  FILLER                  PIC X(08).
003000 WORKING-STORAGE SECTION.
003100 01  MY-PROGRAM-ID               PIC X(08) VALUE 'COBV0ERR'.
003200 01  PROC-STATUS                 PIC X(01) VALUE '0'.
003300     88  SYSIPT-PROC                       VALUE 'P'.
003400 01  SYSIPT-STATUS               PIC X(01) VALUE '0'.
003500     88  SYSIPT-EOF                        VALUE '4'.
003600 01  SAVE-SYSIPT                 VALUE SPACES.
003700     05  FILLER                  PIC X(06).
003700     05  SAVE-SYSIPT-COMMENT     PIC X(01).
003800     05  SAVE-SYSIPT-MARGIN-A    PIC X(04).
003900     05  FILLER                  PIC X(69).
004000 01  I                           PIC S9(4) BINARY.
004100 01  TEXT-DATABASE-G.
004200     05  FILLER                  PIC X(01) VALUE QUOTE.
004300     05  FILLER                  PIC X(08) VALUE 'DATABASE'.
004400     05  FILLER                  PIC X(01) VALUE QUOTE.
004500 01  TEXT-DATABASE REDEFINES TEXT-DATABASE-G PIC X(10).
004600 01  TEXT-GDTCALL-G.
004700     05  FILLER                  PIC X(01) VALUE QUOTE.
004800     05  FILLER                  PIC X(07) VALUE 'GDTCALL'.
004900     05  FILLER                  PIC X(01) VALUE QUOTE.
005000 01  TEXT-GDTCALL REDEFINES TEXT-GDTCALL-G PIC X(09).
005100 01  TEXT-SETASOF-G.
005200     05  FILLER                  PIC X(01) VALUE QUOTE.
005300     05  FILLER                  PIC X(07) VALUE 'SETASOF'.
005400     05  FILLER                  PIC X(01) VALUE QUOTE.
005500 01  TEXT-SETASOF REDEFINES TEXT-SETASOF-G PIC X(09).
005600 01  TEXT-SYSCALL-G.
005700     05  FILLER                  PIC X(01) VALUE QUOTE.
005800     05  FILLER                  PIC X(07) VALUE 'SYSCALL'.
005900     05  FILLER                  PIC X(01) VALUE QUOTE.
006000 01  TEXT-SYSCALL REDEFINES TEXT-SYSCALL-G PIC X(09).
006100 01  TEXT-CALL-G1.
006200     05  FILLER                  PIC X(05) VALUE 'CALL '.
006300     05  FILLER                  PIC X(01) VALUE QUOTE.
006400 01  TEXT-CALL-1  REDEFINES TEXT-CALL-G1 PIC X(6).
006500 01  TEXT-CALL-G2.
006600     05  FILLER                  PIC X(06) VALUE 'CALL '.
006700     05  FILLER                  PIC X(01) VALUE QUOTE.
006800 01  TEXT-CALL-2  REDEFINES TEXT-CALL-G2 PIC X(7).
006900 01  TEXT-CALL-G3.
007000     05  FILLER                  PIC X(07) VALUE 'CALL '.
007100     05  FILLER                  PIC X(01) VALUE QUOTE.
007200 01  TEXT-CALL-3  REDEFINES TEXT-CALL-G3 PIC X(8).
007300 LINKAGE SECTION.
007400 01  PARM-FIELD.
007500     05  PARM-LEN                PIC S9(4) COMP.
007600     05  PARM-DATA.
007700         10  PARM-CHAR           PIC X(01) OCCURS 0 TO 100 TIMES
007800                                           DEPENDING ON PARM-LEN.
007900 PROCEDURE DIVISION USING        PARM-FIELD.
008000 0000-COBV0ERR.
008100     OPEN INPUT  SYSIPT-FILE
008200     PERFORM 9100-READ-SYSIPT
008300     MOVE SYSIPT-REC TO SAVE-SYSIPT
008400     PERFORM 9100-READ-SYSIPT
008500     PERFORM 1000-PROCESS-SYSIPT
008600         UNTIL SYSIPT-EOF
008700     IF  NOT SYSIPT-PROC
008800         DISPLAY 'COBV0ERR-NO "PROCEDURE DIVISION... " TEXT FOUND'
008900     END-IF
009000     CLOSE       SYSIPT-FILE
009100     GOBACK
009200     .
009300 1000-PROCESS-SYSIPT.
009400     IF  SYSIPT-COMMENT NOT = '*'
009500         IF  SYSIPT-MARGIN-A = 'PROC'
009600             MOVE 'P' TO PROC-STATUS
009700         ELSE
009800         IF  SYSIPT-PROC
009900             PERFORM 1200-PROC-CHECKS
010000         ELSE
010100             PERFORM 1100-WS-CHECKS
010200
010300     .
010400     MOVE SYSIPT-REC TO SAVE-SYSIPT
010500     PERFORM 9100-READ-SYSIPT
010600     .
010700 1100-WS-CHECKS.
010800     MOVE ZERO TO I
010900     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL 'COPY '
011000     IF  I NOT = ZERO
011100     AND ((     SYSIPT-MARGIN-A = '01  '
011110            AND SYSIPT-COMMENT  = SPACE)
011120         OR
011200          (     SAVE-SYSIPT-MARGIN-A = '01  '
011210            AND SAVE-SYSIPT-COMMENT  = SPACE))
011300         DISPLAY 'COBV0ERR-"COPY... " TEXT FOUND'
011400         PERFORM 1100-LIST-3
011500     END-IF
011600     .
011700 1200-PROC-CHECKS.
011800     MOVE ZERO TO I
011900     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL ' ACCEPT '
012000     IF  I NOT = ZERO
012100         DISPLAY 'COBV0ERR-"ACCEPT" TEXT FOUND'
012200         PERFORM 1100-LIST-3
012300     END-IF
012400     MOVE ZERO TO I
012500     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL 'EXAMINE'
012600     IF  I NOT = ZERO
012700         DISPLAY 'COBV0ERR-"EXAMINE" TEXT FOUND'
012800         PERFORM 1100-LIST-3
012900     END-IF
013000     MOVE ZERO TO I
013100     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL TEXT-DATABASE
013200     IF  I NOT = ZERO
013300         DISPLAY 'COBV0ERR-"DATABASE" TEXT FOUND'
013400         PERFORM 1100-LIST-3
013500     END-IF
013600     MOVE ZERO TO I
013700     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL TEXT-GDTCALL
013800     IF  I NOT = ZERO
013900         DISPLAY 'COBV0ERR-"GDTCALL" TEXT FOUND'
014000         PERFORM 1100-LIST-3
014100     END-IF
014200     MOVE ZERO TO I
014300     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL TEXT-SETASOF
014400     IF  I NOT = ZERO
014500         MOVE ZERO TO I
014600         INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL ' VALUE '
014700         IF  I = ZERO
014800             DISPLAY 'COBV0ERR-"SETASOF" TEXT FOUND'
014900             PERFORM 1100-LIST-3
015000         END-IF
015100     END-IF
015200     MOVE ZERO TO I
015300     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL TEXT-SYSCALL
015400     IF  I NOT = ZERO
015500         DISPLAY 'COBV0ERR-"SYSCALL" TEXT FOUND'
015600         PERFORM 1100-LIST-3
015700     END-IF
015800     MOVE ZERO TO I
015900     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL TEXT-CALL-1
016000     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL TEXT-CALL-2
016100     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL TEXT-CALL-3
016200     IF  I NOT = ZERO
016300         DISPLAY 'COBV0ERR-"CALL ..." TEXT FOUND'
016400         PERFORM 1100-LIST-3
016500     END-IF
016600     MOVE ZERO TO I
016700     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL
016800                                            ' CURRENT-DATE '
016900     IF  I NOT = ZERO
017000         MOVE ZERO TO I
017100         INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL
017200                                                ' FUNCTION '
017300         IF  I = ZERO
017400             DISPLAY 'COBV0ERR-"CURRENT-DATE" TEXT FOUND'
017500             PERFORM 1100-LIST-3
017600         END-IF
017700     END-IF
017800     MOVE ZERO TO I
017900     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL ' TIME-OF-DAY'
018000     IF  I NOT = ZERO
018100         DISPLAY 'COBV0ERR-"TIME-OF-DAY" TEXT FOUND'
018200         PERFORM 1100-LIST-3
018300     END-IF
018400     MOVE ZERO TO I
018500     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL ' TRANSFORM '
018600     IF  I NOT = ZERO
018700         DISPLAY 'COBV0ERR-"TRANSFORM" TEXT FOUND'
018800         PERFORM 1100-LIST-3
018900     END-IF
019000     INSPECT SYSIPT-MARGIN-B TALLYING I FOR ALL 'STOP RUN'
019100     IF  I NOT = ZERO
019200         DISPLAY 'COBV0ERR-"STOP RUN " TEXT FOUND'
019300         PERFORM 1100-LIST-3
019400     END-IF
019500     .
019600 1100-LIST-3.
019700     DISPLAY SAVE-SYSIPT
019800     DISPLAY SYSIPT-REC
019900     PERFORM 9100-READ-SYSIPT
020000     DISPLAY SYSIPT-REC
020100     .
020200 9100-READ-SYSIPT.
020300     IF SYSIPT-EOF
020400         MOVE '999999*----END OF FILE ON COBIPT----*'
020500               TO SYSIPT-REC
020600     ELSE
020700     READ SYSIPT-FILE
020800         AT END
020900         MOVE '4' TO SYSIPT-STATUS
021000     .
021100 END PROGRAM COBV0ERR.
-END
