Google
 

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.