📄 billone.cbl
字号:
07 IT-TYPE PIC X(01).
07 IT-BILL-NO PIC 9(5).
05 IT-slno pic 9(03).
03 IT-T-CODE.
05 IT-PR-TYPE PIC X.
05 IT-CODE PIC X(06).
03 IT-VALID PIC X.
03 IT-SCH-CODE PIC X.
03 IT-BAT PIC X(6).
02 TRANS-ZERO.
03 IT-EXP PIC 9(4).
03 IT-TAX-ID PIC 9.
03 IT-QTY PIC 9(4).
03 IT-BILL-AMT PIC 9(5)V99.
03 IT-TAX-AMT PIC 9(5)V99.
03 IT-DISC-AMT PIC 9(5)V99.
03 IT-COST PIC 9(5)V99.
02 IT-REC-END PIC X.
FD PRINT-FILE LABEL RECORDS OMITTED.
01 PR-REC PIC X(80).
WORKING-STORAGE SECTION.
77 doct-code pic x(6) value spaces.
77 tot-amt pic 9(9)v99 value 0.
77 j pic 9(3) value 0.
77 no-trans pic x value 'N'.
77 esc-key pic x value 'N'.
77 con-pri pic x value 'Y'.
77 from-tot pic x value 'N'.
77 END-FILE PIC X VALUE 'N'.
01 ROUND-PARA.
03 ROUND-AMT PIC SV99.
03 NETT-AMT PIC 9(7)V99.
02 WS-NETT-AMT PIC 9(8)V99.
02 WNETT PIC 9(8)V99.
02 WCCR1 PIC 9(8) VALUE ZEROS.
02 WCCR2 PIC 9(8)V99 VALUE ZEROS.
02 WCCR3 PIC 9(8)V99 VALUE ZEROS.
02 MULTI-VAR PIC 99 VALUE ZEROS.
02 WCCR4 PIC 9(7)V99 VALUE ZEROS.
01 F-N PIC X(14) VALUE 'connect.EXE '.
01 f-d.
02 FILE-SIZE pic x(8) comp-x.
02 FILE-DATE PIC X(3) COMP-X.
02 FILE-TIME PIC X(4) COMP-X.
01 ORG-NAME PIC X(40) VALUE SPACES.
01 add1 PIC X(40) VALUE SPACES.
01 STAT-CODE PIC 99 COMP-X.
01 91-RESULT PIC 99 COMP-X VALUE ZEROS.
01 91-FUNCTION PIC 99 COMP-X VALUE 35.
01 91-PAR PIC 99 COMP-X VALUE 0.
01 key-status.
05 key-type pic x.
05 key-code-1 pic 9(2) comp-x.
05 filler pic x.
01 go-dri.
02 w-dri pic x value spaces.
02 pic x value ':'.
01 ch-dir.
02 pic x value '\'.
02 ws-wdir pic x(8) value spaces.
01 ch-dir1 pic x(8) value spaces.
01 SORG PIC X(40) VALUE SPACES.
01 WS-SPACES.
02 I PIC 99 VALUE ZEROS.
02 Y-N PIC X VALUE SPACES.
02 O-A PIC X VALUE SPACES.
01 WS-FST.
02 CHECK-FST PIC XX VALUE '00'.
02 CHECK-FST-1 REDEFINES check-FST.
04 CFST-1-1 PIC 99 COMP-X.
04 CFST-1-2 PIC 99 COMP-X.
02 CHECK-FST-2 REDEFINES check-FST.
04 CFST-2-1 PIC X.
04 CFST-2-2 PIC X.
01 ITE-YYf PIC 99.
01 ITE-YY-FULL PIC 9999 VALUE ZEROES.
01 FROM-DATE PIC 9(8) VALUE ZEROS.
01 REDEFINES FROM-DATE.
02 FR-DD PIC 99.
02 FR-MM PIC 99.
02 FR-YYf PIC 99.
02 FR-YY PIC 99.
01 TO-DATE PIC 9(8) VALUE ZEROS.
01 REDEFINES TO-DATE.
02 TO-DD PIC 99.
02 TO-MM PIC 99.
02 TO-YY-FULL PIC 9999.
02 REDEFINES TO-YY-FULL.
03 TO-YYf PIC 99.
03 TO-YY PIC 99.
01 WS-PR-CODE PIC X(6) VALUE SPACES.
01 WS-PR-name pIC X(30) VALUE SPACES.
01 w-datef pic 9(8) value zeroes.
01 redefines w-datef.
02 w-yyf pic 99.
02 w-date.
03 W-YY PIC 99.
03 W-MM PIC 99.
03 W-DD PIC 99.
01 head-id.
02 hed-dri pic x(7) value 'dpdata\'.
02 hd-yy1 pic 99.
02 hd-mm1 pic 99.
02 hed-ext pic x(7) value 'hed.dat'.
01 det-id.
02 det-dri pic x(7) value 'dpdata\'.
02 dt-yy pic 99.
02 dt-mm pic 99.
02 det-ext pic x(7) value 'det.dat'.
01 cons-date.
02 c-dd pic 99.
02 pic x value '/'.
02 c-mm pic 99.
02 pic x value '/'.
02 c-y1 pic 99.
02 c-y2 pic 99.
01 ws-date1.
03 ws-1-yyf pic 99.
03 ws-1-yy pic 99.
03 ws-1-mm pic 99.
03 ws-1-dd pic 99.
01 ws-date2.
03 ws-2-yyf pic 99.
03 ws-2-yy pic 99.
03 ws-2-mm pic 99.
03 ws-2-dd pic 99.
01 item-id.
02 PIC X(7) VALUE 'DPDATA\'.
02 iteM-yy pic 99.
02 iteM-mm pic 99.
02 iteM-ext pic x(8) value 'ite.dat'.
01 gen-id1.
02 PIC X(7) VALUE 'DPDATA\'.
02 gen-yy pic 99.
02 gen-mm pic 99.
02 gen-ext pic x(7) value 'gen.dat'.
01 SAL-ID.
02 PIC X(6) VALUE 'DPSAL\'.
02 SAL-DATE.
03 SAL-YYMM.
05 SAL-YY PIC 99 VALUE ZEROS.
05 SAL-MM PIC 99 VALUE ZEROS.
03 SAL-DD PIC 99 VALUE ZEROS.
02 SAL-EXT PIC X(6) VALUE 'SA.DAT'.
01 IT-ID.
02 ite-dir PIC X(6) VALUE 'DPITE\'.
02 ITE-DATE PIC 9(6) VALUE ZEROS.
02 REDEFINES ITE-DATE.
03 ITE-YYMM.
05 ITE-YY PIC 99.
05 ITE-MM PIC 99.
03 ITE-DD PIC 99.
02 ITE-EXT PIC X(6) VALUE 'IT.DAT'.
01 print-id.
02 pr-id pic x(10) value spaces.
02 pr-ext pic x(4) value '.spo'.
01 ws-zeros1.
02 abs-det pic x value spaces.
88 abs-det-valid value 'A','d','a','D'.
02 cre-all pic x value spaces.
88 cre-all-valid value 'C','A','c','a'.
02 cus-code pic x(6) value spaces.
01 WS-ZEROS.
02 pline-ctr pic 999 value zeros.
02 ws-page pic 999 value zeros.
02 FIRST-SW PIC 9 VALUE ZEROS.
02 ws-total.
03 last-bill1.
05 last-term-id pic 99 value zeroes.
05 last-type pic x value spaces.
05 last-bill-no pic 9(5) value zeros.
03 tot-bill-amt pic s9(7)v99 value zeros.
02 print-sw pic 9 value zeros.
02 m pic 99 value zero.
02 n pic 99 value zero.
02 l-page pic 999 value zeros.
02 redefines l-page.
03 l-1 pic 99.
03 l-2 pic 9.
02 zz pic 99 value zeros.
02 redefines zz.
03 z1 pic 9.
03 z2 pic 9.
02 more-sw pic 9(01) VALUE ZEROS.
02 END-SW PIC 9 VALUE ZEROS.
02 esc-SW PIC 9 VALUE ZEROS.
02 home-sw pic 9(01) VALUE ZEROS.
02 esav-sw pic 9(01) VALUE ZEROS.
02 MAX-LINE PIC 99 VALUE ZEROS.
02 TEMP PIC 99 VALUE ZEROS.
02 YES-SW PIC 9 VALUE ZEROS.
02 dpage pic 999 VALUE ZEROS.
02 REDEFINES DPAGE.
03 ws-1 pic 99.
03 ws-2 pic 9.
01 BLANKER PIC X(37) VALUE SPACES.
01 WSIN PIC X(14) VALUE SPACES.
01 REDEFINES WSIN.
02 WS-IN PIC X OCCURS 14 TIMES.
01 WSOUT PIC X(14) VALUE SPACES.
01 REDEFINES WSOUT.
02 WS-OUT PIC X OCCURS 14 TIMES.
01 SCR-POS PIC X COMP-X VALUE ZERO.
01 SC-BUFF VALUE SPACES.
02 SCR-CH-BUFF PIC X(2000) OCCURS 10 TIMES.
01 SA-BUFF VALUE SPACES.
02 SCR-AT-BUFF PIC X(2000) OCCURS 10 TIMES.
01 STR-LEN PIC X(2) COMP-X VALUE 2000.
01 HD-1.
02 F PIC X(78) VALUE
" Date Bill No Value Product name
- " Qty ".
01 HD-1a.
02 F PIC X(78) VALUE
" Date Bill No Value
- " ".
01 Lico.
03 li pic 99 value zeros.
03 co pic 99 value zeros.
01 DD-L.
02 F PIC X(6) VALUE spaces.
02 DDATE.
03 DDD PIC 99 blank when ZEROS.
03 HY1 PIC X VALUE SPACES.
03 DMM PIC 99 blank when ZEROS.
03 HY2 PIC X VALUE SPACES.
03 DYY PIC 99 value ZEROS.
02 F PIC X(3) VALUE SPACES.
02 DBILL-type PIC X VALUE SPACES.
02 Dterm-id PIC xx value spaces.
02 DBILL-NO PIC X(5) VALUE SPACES.
02 f pic x value spaces.
02 dbill-amt pic ------.99 value zeroes.
02 f pic x(4) value spaces.
02 dname pic x(27) value spaces.
02 f pic x value spaces.
02 dqty pic zzz9 blank when zeroes.
02 f pic x value spaces.
01 DTOT-LINE.
02 FILLER PIC X(17) VALUE SPACES.
02 FILLER PIC X(7) VALUE "Total ".
* 02 FILLER PIC X(7) VALUE SPACES.
02 Dbill-amt-tot PIC --------.99 blank when zeros.
01 II PIC 99 VALUE ZEROS.
01 P-D PIC X VALUE SPACES.
88 PD-VALID VALUES ARE 'P','S','D'.
01 phead.
02 porg-name pic x(40) value spaces.
01 phead-add.
02 p-add pic x(40) value spaces.
01 PHEAD1.
02 phead1a.
03 filler pic x(13) value "Purchases by ".
03 pparty-name pic x(20).
03 filler pic x value '('.
03 pgen-code pic x(6).
03 filler pic x value ')'.
02 phead1b.
03 filler pic x value spaces.
03 pfrom-date pic 99/99/9999.
03 filler pic x(04) value " to ".
03 pto-date pic 99/99/9999.
03 filler pic x(3) value spaces.
03 filler pic x(7) value "Page : ".
03 ppage pic zzz.
01 pdash-line.
02 pic x(80) value all "-".
01 pdash-line1.
02 pic x(41) value all "-".
01 FUDET.
02 F-1 PIC 99 COMP-0 VALUE ZERO.
01 FDETX REDEFINES FUDET.
02 FIL1 PIC X.
02 FIL2 PIC X.
01 FUN-FUN.
02 FILLER PIC 99 COMP-X VALUE 0.
01 FUN-PAR.
02 FUN-REG PIC 99 COMP-X.
02 FUN-LEN1 PIC 99 COMP-X VALUE 2.
02 FUN-DET1.
03 FE-1 PIC X.
03 FE-2 PIC X VALUE ";".
02 FUN-LEN2 PIC 99 COMP-X VALUE 2.
02 FUN-DET2.
03 FE-3 PIC X.
03 FE-4 PIC X VALUE "<".
02 FUN-LEN3 PIC 99 COMP-X VALUE 2.
02 FUN-DET3.
03 FE-5 PIC X.
03 FE-6 PIC X VALUE "=".
02 FUN-LEN4 PIC 99 COMP-X VALUE 2.
02 FUN-DET4.
03 FE-7 PIC X.
03 FE-8 PIC X VALUE ">".
02 FUN-LEN5 PIC 99 COMP-X VALUE 2.
02 FUN-DET5.
03 FE-9 PIC X.
03 FE-10 PIC X VALUE "?".
02 FUN-LEN6 PIC 99 COMP-X VALUE 2.
02 FUN-DET6.
03 FE-11 PIC X.
03 FE-12 PIC X VALUE "@".
02 FUN-LEN7 PIC 99 COMP-X VALUE 2.
02 FUN-DET7.
03 FE-13 PIC X.
03 FE-14 PIC X VALUE "A".
02 FUN-LEN8 PIC 99 COMP-X VALUE 2.
02 FUN-DET8.
03 FE-15 PIC X.
03 FE-16 PIC X VALUE "B".
02 FUN-LEN9 PIC 99 COMP-X VALUE 2.
02 FUN-DET9.
03 FE-17 PIC X.
03 FE-18 PIC X VALUE "C".
02 fun-len10 pic 99 comp-x value 2.
02 fun-det10.
03 fe-19 pic x.
03 fe-20 pic x value "D".
02 fun-len11 pic 99 comp-x value 2.
02 fun-det11.
03 fe-21 pic x.
03 fe-22 pic x value "H".
02 fun-len12 pic 99 comp-x value 2.
02 fun-det12.
03 fe-23 pic x.
03 fe-24 pic x value "P".
02 fun-len13 pic 99 comp-x value 2.
02 fun-det13.
03 fe-25 pic x.
03 fe-26 pic x value "I".
02 fun-len14 pic 99 comp-x value 2.
02 fun-det14.
03 fe-27 pic x.
03 fe-28 pic x value "Q".
02 fun-len15 pic 99 comp-x value 2.
02 fun-det15.
03 fe-29 pic x.
03 fe-30 pic x value "G".
02 fun-len16 pic 99 comp-x value 2.
02 fun-det16.
03 fe-31 pic x.
03 fe-32 pic x value "O".
02 fun-len17 pic 99 comp-x value 2.
02 fun-det17.
03 fe-33 pic x.
03 fe-34 pic x value "M".
02 fun-len18 pic 99 comp-x value 2.
02 fun-det18.
03 fe-35 pic x.
03 fe-36 pic x value "K".
02 fun-len19 pic 99 comp-x value 2.
02 fun-det19.
03 fe-37 pic x.
03 fe-38 pic x value "⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -