PDP-10 Archive: uetp/lib/pbrpt.cbl from BB-H137D-BM

Trailing-Edge - PDP-10 Archives - BB-H137D-BM - uetp/lib/pbrpt.cbl

There are 13 other files named pbrpt.cbl in the archive. Click here to see a list.

IDENTIFICATION DIVISION.
PROGRAM-ID.  PBRPT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.  CHANNEL (1)  TOP-OF-FORM.



INPUT-OUTPUT SECTION.
FILE-CONTROL.
	SELECT IN-FILE ASSIGN TO DSK.
	SELECT SORT-FILE ASSIGN DSK,DSK,DSK.
	SELECT PRINT-FILE ASSIGN TO DSK.
	SELECT PBINPT-FILE ASSIGN TO DSK
		RECORDING MODE IS ASCII.

DATA DIVISION.
FILE SECTION.
FD  PBINPT-FILE
	VALUE OF ID 'PBINPTFIL'.
01  PBINPT-REC			PIC X(100).


FD  PRINT-FILE
	VALUE OF ID IS PRNT-LABEL-WS.
01  PRINT-REC.
	05  PARENT-P		PIC Z(9).
	05  FILLER		PIC XXX.
	05  BRANCH-P		PIC Z(9).
	05  FILLER		PIC XXX.
	05  METER-P		PIC Z(9).
	05  FILLER		PIC XXX.
	05  UPDATED-P		PIC Z(9).
	05  FILLER		PIC XXX.
	05  ACT-RECS-P		PIC Z(9).
	05  FILLER		PIC XXX.
	05  CUSTOMER-P		PIC Z(9).
	05  FILLER		PIC XXX.
	05  DATE-P		PIC X(8).

FD IN-FILE VALUE OF ID IS CRT12-REPORT-FILE-NME.
01  POSTAL-REC.
	05  PARENT-P		PIC 9(4).
	05  BRANCH-P		PIC 9(4).
	05  METER-P		PIC 9(5).
	05  UPDATED-P		PIC 9(5).
	05  ACT-RECS-P		PIC 9(5).
	05  CUSTOMER-P		PIC 9(5).
	05  DATE-P		PIC 9(6).
SD	SORT-FILE
	RECORD CONTAINS 100 CHARACTERS.
01	SORT-REC.
	05  PARENT-P		PIC 9(4).
	05  BRANCH-P		PIC 9(4).
	05  METER-P		PIC 9(5).
	05  UPDATED-P		PIC 9(5).
	05  ACT-RECS-P		PIC 9(5).
	05  CUSTOMER-P		PIC 9(5).
	05  DATE-P		PIC 9(6).

*	05  FILLER		PIC X(64).

WORKING-STORAGE SECTION.

01  CRT12-REPORT-FILE-NME		PIC X(9).
01  PRNT-LABEL-WS		PIC X(9).
01  REC-COUNT-WS		PIC 99999  VALUE ZERO.

01  LIN-CNT-WS			PIC 9(4)  VALUE 9999.


01  DATE-HOLD-WS.
	05  YR-HOLD-WS		PIC 99.
	05  MO-HOLD-WS		PIC 99.
	05  DY-HOLD-WS		PIC 99.
01  DATE-MASK-WS.
	05  MO-WS		PIC 99.
	05  FILLER		PIC X   VALUE '/'.
	05  DY-WS		PIC 99.
	05  FILLER		PIC X   VALUE '/'.
	05  YR-WS		PIC 99.



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 MY-JOB-NUMBER		PIC S9(10) COMP.
01 MY-TERMINAL-NUMBER	PIC S9(10) COMP.




01 HEADING1-WS.
	05  HD1-WS		PIC X(12)  VALUE '  PARENT'.
	05  HD2-WS		PIC X(12)  VALUE '  BRANCH'.
	05  HD3-WS		PIC X(12)  VALUE '   METER'.
	05  HD4-WS		PIC X(12)  VALUE ' # OF TIMES'.
	05  HD5-WS		PIC X(12)  VALUE ' NUMBER OF'.
	05  HD6-WS		PIC X(12)  VALUE '  CUSTOMER'.
	05  HD7-WS		PIC X(8)  VALUE '  DATE'.



01  HEADING2-WS.
	05  HD8-WS		PIC X(12)  VALUE 'POST OFFICE'.
	05  HD9-WS		PIC X(12)  VALUE 'POST OFFICE'.
	05  HD10-WS		PIC X(12)  VALUE '   NUMBER'.
	05  HD11-WS		PIC X(12)  VALUE '  UPDATED'.
	05  HD12-WS		PIC X(12)  VALUE 'ACTIVITY REC'.
	05  HD13-WS		PIC X(12)  VALUE '   NUMBER'.
	05  HD14-WS		PIC X(8)  VALUE SPACES.

01 COMMUNICATION-RECORD COPY COMREC.

PROCEDURE DIVISION.
START.




	MOVE ZERO TO CR-TRANSACTION-SUBTYPE.


	DISPLAY ' PROGRAM HAS TWO FUNCTIONS:'.
	DISPLAY '    01 = NORMAL POSTAL REPORT'.
	DISPLAY '    02 = SORT 20,000 TEST RECORDS'
	DISPLAY '        AND LIST FIRST AND LAST FIFTY RECORDS'.
	DISPLAY 'ENTER CODE (01 OR 02)? >' WITH NO ADVANCING.
	ACCEPT CR-TRANSACTION-NUMBER.

	IF CR-TRANSACTION-NUMBER = 01 GO TO CALL-ROUTINES-DBMS.
	IF CR-TRANSACTION-NUMBER = 02 GO TO TEST-SORT-ROUTINE.
	DISPLAY ' WRONG CODE - TRY AGAIN...'.
	GO TO START.



CALL-ROUTINES-DBMS.

	MOVE 'POSTALRPT' TO PRNT-LABEL-WS.

	DISPLAY 'PLEASE ENTER THE NAME OF THE POSTAL PRINT FILE'.
	DISPLAY '   DEFAULT IS POSTAL.FIL'.
	DISPLAY 'FILE? >' WITH NO ADVANCING.
	
	ACCEPT CRT12-REPORT-FILE-NAME.


	IF CRT12-REPORT-FILE-NAME = SPACES
		MOVE 'POSTALFIL' TO CRT12-REPORT-FILE-NAME.

 	MOVE CRT12-REPORT-FILE-NAME TO CRT12-REPORT-FILE-NME.





PRINT-OPTIONS-SWITCH.
	DISPLAY 'OPTIONS - 12 -- ACCESS DATA BASE'.
	DISPLAY '        - 15 -- ACCESS POSTAL FILE ONLY'.
	DISPLAY 'TYPE?  >' WITH NO ADVANCING.
	ACCEPT CR-TRANSACTION-NUMBER.



	IF CR-TRANSACTION-NUMBER = 15
		GO TO SORT-POSTAL-FILE.



	IF CR-TRANSACTION-NUMBER NOT = 12
		DISPLAY ' WRONG TYPE CODE (12 OR 15 ONLY) '
		DISPLAY '   PLEASE TRY AGAIN...'
		GO TO PRINT-OPTIONS-SWITCH.






	MOVE 1 TO USER-PRIORITY.
	MOVE 'REPORT' 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.

	MOVE 98 TO CR-TRANSACTION-NUMBER.
	CALL DBOPEN USING COMMUNICATION-RECORD.
	IF CR-RETURN-CODE > ZERO
		DISPLAY '[COULD NOT OPEN DATA BASE]'
		GO TO STOP-RUN
	  ELSE
		NEXT SENTENCE.



	MOVE 12 TO CR-TRANSACTION-NUMBER.
	MOVE 0 TO CR-transaction-subtype.
CALL-LOOP-DBTRAN.
	CALL DBTRAN USING COMMUNICATION-RECORD.
	IF CR-return-code > 0
*	    THEN
		DISPLAY '[Could not get data base report data]'
		DISPLAY CR-RETURN-CODE
		GO TO CLOSE-DBMS-X
	    ELSE
		NEXT SENTENCE.





	IF CR-TRANSACTION-SUBTYPE NOT = 4
		GO TO CALL-LOOP-DBTRAN.



CLOSE-DBMS-X.


	MOVE 99 TO CR-transaction-number.
	CALL DBCLOS USING COMMUNICATION-RECORD.
	GO TO SORT-POSTAL-FILE.

STOP-RUN.
	STOP RUN.





SORT-POSTAL-FILE.


	SORT SORT-FILE ON
		ASCENDING KEY PARENT-P OF SORT-REC
		DESCENDING KEY BRANCH-P OF SORT-REC
		ASCENDING KEY METER-P OF SORT-REC
		ASCENDING KEY CUSTOMER-P OF SORT-REC
		INPUT PROCEDURE IS GET-THEM
		OUTPUT PROCEDURE IS TYPE-THEM.
END-IT.
	STOP RUN.
GET-THEM SECTION.
GET-START.
	OPEN INPUT IN-FILE.
RELEASE-LOOP.
	READ IN-FILE; AT END GO TO GET-THEM-EXIT.

	MOVE CORRESPONDING POSTAL-REC TO SORT-REC.

	RELEASE SORT-REC.
	GO TO RELEASE-LOOP.
GET-THEM-EXIT.
	CLOSE IN-FILE.

END-OF-GET-SECTION.
	EXIT.



TYPE-THEM SECTION.
OPEN-PRINT-FILE.
	OPEN OUTPUT PRINT-FILE.

	MOVE SPACES TO PRINT-REC.
	MOVE ZEROS TO POSTAL-REC.

RETURN-LOOP.
	RETURN SORT-FILE AT END GO TO END-OF-TYPE.


CHECK-HOF.
	IF LIN-CNT-WS > 55
		PERFORM HEADING-ROUTINE THRU HEADINGS-EXIT.


	IF PARENT-P IN POSTAL-REC NOT = PARENT-P
		IN SORT-REC

		MOVE SPACES TO PRINT-REC
	        PERFORM PRINT-A-LINE.




	MOVE CORRESPONDING SORT-REC TO PRINT-REC.


CHECK-EQ-FIELDS.
	IF PARENT-P IN POSTAL-REC = PARENT-P
		IN SORT-REC

		MOVE ZEROS TO PARENT-P IN PRINT-REC.


	IF BRANCH-P IN POSTAL-REC = BRANCH-P
		IN SORT-REC

		MOVE ZEROS TO BRANCH-P IN PRINT-REC.



	IF METER-P IN POSTAL-REC = METER-P
		IN SORT-REC

		MOVE ZEROS TO METER-P IN PRINT-REC.



	IF CUSTOMER-P IN POSTAL-REC = CUSTOMER-P
		IN SORT-REC

		MOVE ZEROS TO CUSTOMER-P IN PRINT-REC.





DATE-MASKING.
	MOVE DATE-P IN SORT-REC TO DATE-HOLD-WS.
	MOVE MO-HOLD-WS TO MO-WS.
	MOVE DY-HOLD-WS TO DY-WS.
	MOVE YR-HOLD-WS TO YR-WS.

	MOVE DATE-MASK-WS TO DATE-P IN PRINT-REC.


	IF DATE-HOLD-WS = ZEROS
		MOVE SPACES TO DATE-P IN PRINT-REC.


WRITE-PRINT-LINE.
	PERFORM PRINT-A-LINE.

RETURN-TO-SORT-READ.


	MOVE CORRESPONDING SORT-REC TO POSTAL-REC.



	GO TO RETURN-LOOP.


HEADING-ROUTINE.
	MOVE ZERO TO LIN-CNT-WS.
	MOVE SPACES TO PRINT-REC.
ADVANCE-HOF.
	WRITE PRINT-REC BEFORE ADVANCING TOP-OF-FORM.


HEADINGS-1-2.


	MOVE HEADING1-WS TO PRINT-REC.
	PERFORM PRINT-A-LINE.



	MOVE HEADING2-WS TO PRINT-REC.
	PERFORM PRINT-A-LINE  3 TIMES.


HEADINGS-EXIT.
	EXIT.



PRINT-A-LINE.
	WRITE PRINT-REC.
	MOVE SPACES TO PRINT-REC.


	ADD 1 TO LIN-CNT-WS.


END-OF-TYPE.

	CLOSE PRINT-FILE.




PRINTING-EXIT.
	EXIT.




TEST-SORT-ROUTINE SECTION.
	SORT SORT-FILE
		DESCENDING KEY PARENT-P IN SORT-REC
		DESCENDING KEY BRANCH-P IN SORT-REC
	   INPUT PROCEDURE IS PBINPT-GET
	   OUTPUT PROCEDURE IS PBINPT-PRINT.


TSR-END.
	GO TO END-IT.





PBINPT-GET SECTION.

	OPEN INPUT PBINPT-FILE.
PBINPT-READ.
	READ PBINPT-FILE AT END GO TO PBINPT-CLOSE.

	MOVE PBINPT-REC TO SORT-REC.
	RELEASE SORT-REC.

	GO TO PBINPT-READ.
PBINPT-CLOSE.
	CLOSE PBINPT-FILE.
PBINPT-IP-EXIT.
	EXIT.


PBINPT-PRINT SECTION.
	MOVE 'PBSORTRPT' TO PRNT-LABEL-WS.
	OPEN OUTPUT PRINT-FILE.
	MOVE SPACES TO PRINT-REC.
	MOVE ZEROS TO LIN-CNT-WS.
PBINPT-RELEASE.
	RETURN SORT-FILE AT END GO TO PBINPT-END.
PBINPT-LOOP.
	IF LIN-CNT-WS > 50
		WRITE PRINT-REC BEFORE ADVANCING TOP-OF-FORM
		MOVE ZEROS TO LIN-CNT-WS.





	IF REC-COUNT-WS > 50 AND < 19951
		GO TO PBINPT-ADD.



PBINPT-MOVE.
	MOVE SORT-REC TO PRINT-REC.

	PERFORM PRINT-A-LINE.

PBINPT-ADD.

	ADD 1 TO REC-COUNT-WS.



PBINPT-RETURN.
	GO TO PBINPT-RELEASE.




PBINPT-END.
	CLOSE PRINT-FILE.


PBINPT-EOJ.
	EXIT.


END-ROUTINE SECTION.
EOJ-EXIT.
	EXIT.