Trailing-Edge
-
PDP-10 Archives
-
BB-H137C-BM
-
uetp/lib/batch.cbl
There are 11 other files named batch.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. BATCH.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
OBJECT-COMPUTER. DECSYSTEM-20.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILIN ASSIGN TO INFILE.
DATA DIVISION.
FILE SECTION.
FD FILIN
LABEL RECORDS ARE STANDARD
RECORDING MODE IS ASCII
VALUE OF ID IS IN-FILE-NAME
DATA RECORD INREC.
01 INREC PIC X(29) USAGE DISPLAY-7.
WORKING-STORAGE SECTION.
01 IN-FILE-NAME.
02 IN-FILE PIC X(6).
02 IN-FILE-EXT PIC X(3) VALUE IS "FIL".
01 FILE-NAME PICTURE X(120) DISPLAY-7
VALUE IS 'DSK:SHARED.FIL'.
01 FILE-PASSWORD PICTURE X(5) DISPLAY-7.
01 NUMBER-OF-PAGES PICTURE S9(10) COMPUTATIONAL VALUE IS 2.
01 THE-ERROR PICTURE S9(10) COMPUTATIONAL VALUE IS 0.
01 USER-PRIORITY PICTURE S9(10) COMPUTATIONAL VALUE IS 0.
01 TRANS-TYPE PIC S9(10) COMP.
01 MY-JOB-NUMBER PIC S9(10) COMP.
01 MY-TERMINAL-NUMBER PIC S9(10) COMP.
01 WORK-TODAY.
02 YYMMDD.
03 YY PIC XX.
03 MM PIC XX.
03 DD PIC XX.
02 HHMMSS.
03 HHMM.
04 HH PIC XX.
04 MN PIC XX.
03 SS PIC XX.
01 TRANS-IN PIC S9(10) COMP VALUE ZERO.
01 TRANS-SENT PIC S9(10) COMP VALUE ZERO.
01 TRANS-OK PIC S9(10) COMP VALUE ZERO.
01 WORK-REC COPY PBTRAN.
01 COMMUNICATION-RECORD COPY COMREC.
01 ERR-MSGS.
02 F PIC X(25) VALUE
'NO METER'.
02 F PIC X(25) VALUE
'ALREADY HAS A METER'.
02 F PIC X(25) VALUE
'NO CUSTOMER'.
02 F PIC X(25) VALUE
'ALREADY CUSTOMER'.
02 F PIC X(25) VALUE
'NO BRANCH PO'.
02 F PIC X(25) VALUE
'METER CUST LINKED'.
02 F PIC X(25) VALUE
'METER BRANCH LINKED'.
02 F PIC X(25) VALUE
'NO PARENT PO'.
02 F PIC X(25) VALUE
'BRANCH PARENT LINKED'.
02 F PIC X(25) VALUE
'METER CUST NOT LINKED'.
02 F PIC X(25) VALUE
'ALREADY PARENT PO'.
02 F PIC X(25) VALUE
'ALREADY BRANCH PO'.
02 F PIC X(25) VALUE
'DATABASE ERROR'.
01 REMSG REDEFINES ERR-MSGS.
02 EMS PIC X(25) OCCURS 13 TIMES.
01 THE-RECORD-COUNT PIC S9(10) COMP.
01 THE-RECORD-TURNOVER PIC S9(10) COMP.
PROCEDURE DIVISION.
START.
MOVE 1 TO USER-PRIORITY.
MOVE 'BATCH' TO CR-user-application.
DISPLAY 'Your Identification (8 chars):' WITH NO ADVANCING.
ACCEPT CR-user-identity.
MOVE MY-JOB-NUMBER TO CR-user-job-number.
MOVE MY-TERMINAL-NUMBER TO CR-user-terminal-number.
CALL PBDBMS USING COMMUNICATION-RECORD.
START-BATCH.
DISPLAY 'INPUT FILE NAME : ' WITH NO ADVANCING.
ACCEPT IN-FILE.
OPEN INPUT FILIN.
MOVE 98 TO CR-transaction-number.
CALL DBOPEN USING COMMUNICATION-RECORD.
IF CR-RETURN-CODE NOT = 0
* THEN
DISPLAY '[DATA BASE OPEN ERROR]'
GO TO END-BATCH
ELSE
DISPLAY '[Data Base Now Open]'.
READ-DATA.
READ FILIN INTO WORK-REC
AT END GO TO END-BATCH.
SET TRANS-IN UP BY 1.
MOVE TRANS-IN TO CR-user-transaction-count.
SET THE-RECORD-COUNT UP BY 1.
IF THE-RECORD-COUNT = 100
* THEN
DISPLAY '[' TRANS-IN ' RECORDS] ' TODAY
MOVE 0 TO THE-RECORD-COUNT
ELSE
NEXT SENTENCE.
PROCESS-TRANS.
IF T-TYPE-1 = 'T'
* THEN
MOVE 0 TO T-TYPE-1
ELSE
NEXT SENTENCE.
IF T-TYPE GREATER ZERO AND LESS 8
GO TO CONTINUE-TRANS.
IF T-TYPE = 13 OR 14
GO TO CONTINUE-TRANS.
NOT-A-VALID-TYPE-FOR-BATCH.
DISPLAY 'NOT A VALID BATCH TYPE'.
DISPLAY WORK-REC.
GO TO READ-DATA.
CONTINUE-TRANS.
MOVE TODAY TO WORK-TODAY.
* MOVE YYMMDD TO CRB-date.
MOVE 030578 TO CRB-DATE.
* MOVE HHMM TO CRB-hhmm.
MOVE 0607 TO CRB-HHMM.
MOVE T-TYPE TO CR-TRANSACTION-NUMBER.
MOVE ZERO TO CR-TRANSACTION-SUBTYPE.
MOVE ZERO TO CR-RETURN-CODE.
MOVE T-METER TO CRB-METER-NUMBER.
MOVE T-CUST TO CRB-CUSTOMER-NUMBER.
MOVE T-BRANCH TO CRB-BRANCH-PO-NUMBER.
MOVE T-PARENT TO CRB-PARENT-PO-NUMBER.
MOVE T-ACT TO CRB-ACTIVITY-CODE.
SET TRANS-SENT UP BY 1.
PASS-TO-PROCESS.
CALL DBTRAN USING COMMUNICATION-RECORD.
* DISPLAY COMMUNICATION-RECORD.
CHECK-RETURN-CODE.
IF CR-GOOD-RETURN
SET TRANS-OK UP BY 1
GO TO READ-DATA.
BAD-RETURN-CODE.
IF CR-RETURN-CODE > 0 AND < 11
GO TO BRC-1.
IF CR-RETURN-CODE = 99
DISPLAY EMS (11)
GO TO BRC-2.
BRC-1.
DISPLAY EMS (CR-RETURN-CODE).
BRC-2.
DISPLAY COMMUNICATION-RECORD.
GET-NEXT-RECORD.
GO TO READ-DATA.
END-BATCH.
MOVE 99 TO CR-TRANSACTION-NUMBER.
CALL DBCLOS USING COMMUNICATION-RECORD.
IF CR-RETURN-CODE NOT = 0
DISPLAY '[DATA BASE CLOSE ERROR]'.
CLOSE FILIN.
DISPLAY TRANS-IN ' TRANS IN'.
DISPLAY TRANS-SENT ' TRANS SENT'.
DISPLAY TRANS-OK ' TRANS OK'.
STOP RUN.