000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. PRN999.
000030******************************************************************
000040* „Tƒ° *
000050******************************************************************
000060 DATE-COMPILED.
000070 ENVIRONMENT DIVISION.
000080 CONFIGURATION SECTION.
000090 SOURCE-COMPUTER. SYSTEM150.
000100 OBJECT-COMPUTER. SYSTEM150.
000110 INPUT-OUTPUT SECTION.
000120 FILE-CONTROL.
000130 SELECT LPF
000140 ASSIGN LPF-PRN999.
000150 DATA DIVISION.
000160 FILE SECTION.
000170 FD LPF
000180 LABEL RECORD OMITTED
000190 LINAGE 66.
000200 01 LP-RC PIC X(300).
000210******************************************************************
000220 WORKING-STORAGE SECTION.
000230 01 QASG01.
000240 03 QASG0101 PIC X(06).
000250 01 QASG02.
000260 03 QASG0201 PIC X(06).
000270 01 FILE-STATUS.
000280 03 STSXXX PIC X(02).
000290 01 WG-AREA.
000300 03 F PIC X(03) VALUE "PRN".
000310 03 WG-PRN PIC 9(03).
000320 01 WG-PRN999.
000330 03 WG-PRN001 PIC N(03).
000340 03 WG-PRN002 PIC N(03).
000350 03 WG-PRN003 PIC N(03).
000360******************************************************************
000370 SCREEN SECTION.
000380 SD GAMEN END STATUS ESTS.
000390 01 GA.
000400 03 GA-PRN LINE 23 COLUMN 77 PIC 9(03) INTO WG-PRN
000410 CHECK OVERFLOW NO IFC.
000420 01 GD.
000430 03 GD-PRN LINE 12 COLUMN 30 PIC N(09) FROM WG-PRN999
000440 BLINK REVERSE.
000450******************************************************************
000460 PROCEDURE DIVISION.
000470 ST.
000480 MOVE "PRN" TO WG-PRN001.
000490 MOVE "999" TO WG-PRN002.
000500 MOVE NC"" TO WG-PRN003.
000510 DISPLAY GD-PRN.
000520 OPEN OUTPUT LPF.
000530 PERFORM MAIN-RTN THRU MAIN-EXT
000540 CLOSE LPF.
000550 ST-END.
000560 STOP RUN.
000570******************************************************************
000580 MAIN-RTN.
000590 ACCEPT GA-PRN.
000600 IF ( WG-PRN = " " ) GO MAIN-EXT.
000610 CLOSE LPF.
000620 MOVE WG-AREA TO QASG0101.
000630 MOVE " " TO QASG0201.
000640 CALL "CBLASGN" USING LPF QASG01 QASG02.
000660 MOVE "PRN" TO WG-PRN001.
000670 MOVE WG-PRN TO WG-PRN002.
000680 MOVE NC"" TO WG-PRN003.
000690 DISPLAY GD-PRN.
000700 OPEN OUTPUT LPF.
000710 GO MAIN-RTN.
000720 MAIN-EXT.
000730 EXIT.