| Author |
RE: REDEFINES in Micro Focus NetExpress 4
|
|
|
| I have the following problem that I do not seem to be able to fix. The
source code (see attachment line 200) has the line;
01 NFLD REDEFINES AFLD PIC Z(4).99-.
When the program runs it gives an illegal value in NFLD when it executes
the line 2348;
MOVE NFLD TO PAID
PAID is defined as (line 75);
77 PAID PIC S9(6)V99.
It seems that the REDEFINES clause used in this manner with PIC will
require the MF directive?
Not sure where to place the directive and what syntax is required. We
tried DIRECTIVE(MF) in the project options, but still get the same
error. We also tried DIRECTIVE(MF) in the single compile options under
tools, but still no luck.
Any advice or ideas?
Thanks
Mark
| |
| HeyBub 2005-05-04, 3:55 pm |
| >> I have the following problem that I do not seem to be able to fix.[color=darkred]
In general, it is not best practice to move an editted field to a data
field.
| |
|
|
HeyBub wrote:
>
>
> In general, it is not best practice to move an editted field to a data
> field.
>
>
Problem is that program is a migration and needs to stay as close to
original as possible.
| |
| Richard 2005-05-04, 8:55 pm |
| > 1) Please do NOT try to send attachments to newsgroups
If it is such bad etiquete then why did you _repost_ it in its
entirity.
| |
| Richard 2005-05-04, 8:55 pm |
| > 1) Please do NOT try to send attachments to newsgroups
If it is such bad etiquete then why did you _repost_ it in its
entirity.
| |
| Richard 2005-05-04, 8:55 pm |
| Geez, you didn't have to post the whole program for one tiny point.
> 01 NFLD REDEFINES AFLD PIC Z(4).99-.
> MOVE NFLD TO PAID
> 77 PAID PIC S9(6)V99.
What you are trying to do is a de-editing move. In ANS'85 this is
allowed as long as the data is aligned correctly in the picture.
Aligned means that the data must be as if a move to the edited numeric
field had been done, the full stop and the sign being in the correct
position.
MicroFocus has always allowed non-standard unaligned de-editing moves,
but recently (last 20 years) this has depended on having the correct
directives set when compiling. The actual directive is:
DE-EDIT"1"
Directives can be put on the compile command line or added to the
directive file if you are using one or, in most cases, as a $SET at the
start of your source code.
However, you should be using:
COMPUTE PAID = FUNCTION NUMVAL(AFLD)
| |
| William M. Klein 2005-05-04, 8:55 pm |
| Sorry, I did NOT realize that my "reply group" included the attachment (or I
would NOT have done so)
--
Bill Klein
wmklein <at> ix.netcom.com
"Richard" <riplin@Azonic.co.nz> wrote in message
news:1115234040.376854.305620@g14g2000cwa.googlegroups.com...
>
> If it is such bad etiquete then why did you _repost_ it in its
> entirity.
>
| |
| Donald Tees 2005-05-04, 8:55 pm |
| William M. Klein wrote:
> Sorry, I did NOT realize that my "reply group" included the attachment (or I
> would NOT have done so)
>
Damned mice.
Donald
;< )
| |
| Richard 2005-05-04, 8:55 pm |
| > Sorry, I did NOT realize
Thank you for that, but that is, in fact, one of the reasons that
top-posters are disliked. They simply put a few lines at the top and
then send the whole thing off without even bothering to check, let
alone attempting to show relevence by trimming back to the actual lines
they are replying to.
| |
|
| Thanks Richard
I will try this and post back if it worked.
Mark
Richard wrote:
> Geez, you didn't have to post the whole program for one tiny point.
>
>
>
>
> What you are trying to do is a de-editing move. In ANS'85 this is
> allowed as long as the data is aligned correctly in the picture.
> Aligned means that the data must be as if a move to the edited numeric
> field had been done, the full stop and the sign being in the correct
> position.
>
> MicroFocus has always allowed non-standard unaligned de-editing moves,
> but recently (last 20 years) this has depended on having the correct
> directives set when compiling. The actual directive is:
>
> DE-EDIT"1"
>
> Directives can be put on the compile command line or added to the
> directive file if you are using one or, in most cases, as a $SET at the
> start of your source code.
>
> However, you should be using:
>
> COMPUTE PAID = FUNCTION NUMVAL(AFLD)
>
| |
| William M. Klein 2005-05-04, 8:55 pm |
| Just so you know, I would NOT have bothered "editing" the post if it included
the entire text of the program (as one reply did). So, to that extent, my
"usual top poster and does not edit" rules apply. I, however, do NOT like
"attachments" because of virus issues (and/or formatting issues).
--
Bill Klein
wmklein <at> ix.netcom.com
"Richard" <riplin@Azonic.co.nz> wrote in message
news:1115238752.032565.282710@o13g2000cwo.googlegroups.com...
>
> Thank you for that, but that is, in fact, one of the reasons that
> top-posters are disliked. They simply put a few lines at the top and
> then send the whole thing off without even bothering to check, let
> alone attempting to show relevence by trimming back to the actual lines
> they are replying to.
>
| |
| Jeff Lanam 2005-05-05, 3:55 am |
| On Wed, 04 May 2005 15:13:03 +0200, mark <meandme1963@yahoo.com>
wrote:
>I have the following problem that I do not seem to be able to fix. The
>source code (see attachment line 200) has the line;
>
>01 NFLD REDEFINES AFLD PIC Z(4).99-.
>
>When the program runs it gives an illegal value in NFLD when it executes
>the line 2348;
>
>MOVE NFLD TO PAID
>
>PAID is defined as (line 75);
>
>77 PAID PIC S9(6)V99.
>
If I understand your program, this is the interesting part. You
didn't say what is being input to the ACCEPT statement. It isn't going
to be validated, so if the input string doesn't match the PIC for
NFLD, you could have a problem. The second MOVE statement is what is
called a "de-editing MOVE", which means that it picks out the value to
move into PAID based on the PICTURE of NFLD. If the wrong character is
in a character position in NFLD, you might get an invalid value error.
Try seeing what is in AFLD/NFLD after the ACCEPT, using DISPLAY or
your debugger.
MOVE SPACES TO AFLD.
ACCEPT AFLD AT 2435.
IF AFLD = SPACES
MOVE DPRC TO PAID
ELSE
MOVE NFLD TO PAID.
Jeff Lanam HP NonStop COBOL Project INCITS/J4
NonStop Enterprise Division
Hewlett-Packard
| |
|
| Hi
Thanks to Richard. Your aswer has solved my problem, system runs
perfectly now.
Thanks
Mark
mnews wrote:
> Thanks Richard
>
> I will try this and post back if it worked.
>
> Mark
>
> Richard wrote:
>
>
| |
| HeyBub 2005-05-06, 3:55 pm |
| >> I have the following problem that I do not seem to be able to fix.[color=darkred]
In general, it is not best practice to move an editted field to a data
field.
| |
|
|
HeyBub wrote:
>
>
> In general, it is not best practice to move an editted field to a data
> field.
>
>
Problem is that program is a migration and needs to stay as close to
original as possible.
| |
| Michael Mattias 2005-05-06, 3:55 pm |
| "mnews" <notspecified@??.???> wrote in message
news:d5ak8p$k2u$1@ctb-nnrp2.saix.net...
> Problem is that program is a migration and needs to stay as close to
> original as possible.
No, the real problem here is semantic: "migrate" does not mean "stubborn,
pigheaded, wooden, no-thought line-for-line, verb-for-verb translation."
MCM
| |
| docdwarf@panix.com 2005-05-06, 3:55 pm |
| In article <d5ak8p$k2u$1@ctb-nnrp2.saix.net>,
mnews <notspecified@??.???> wrote:
>
>
>HeyBub wrote:
[snip]
[color=darkred]
>Problem is that program is a migration and needs to stay as close to
>original as possible.
Problem is that the program doesn't seem to work in its new home and needs
fixing.
DD
| |
| Richard 2005-05-06, 3:55 pm |
| > 1) Please do NOT try to send attachments to newsgroups
If it is such bad etiquete then why did you _repost_ it in its
entirity.
| |
| Richard 2005-05-06, 3:55 pm |
| > 1) Please do NOT try to send attachments to newsgroups
If it is such bad etiquete then why did you _repost_ it in its
entirity.
| |
| William M. Klein 2005-05-06, 3:55 pm |
| 1) Please do NOT try to send attachments to newsgroups
2) There is no problem with you (perfectly valid) redefines of:
01 AFLD PIC X(8).
01 NFLD REDEFINES AFLD PIC Z(4).99-.
3) To set the MF directive on (in your source code), place
$SET MF
as the first line of source code
4) My guess is that this is NOT a problem with the setting of the MF
directive, but of the +/-F run-time switch. Probably the "old" environment ran
with -F and the new one with +F. This run-time switch is specifically designed
to let "dirty" data (non-numeric data) thru rather than to be detected and
reported as "illegal characters".
--
Bill Klein
wmklein <at> ix.netcom.com
"mark" <meandme1963@yahoo.com> wrote in message
news:d5ahqq$h5j$1@ctb-nnrp2.saix.net...[color=darkred]
>I have the following problem that I do not seem to be able to fix. The
> source code (see attachment line 200) has the line;
>
> 01 NFLD REDEFINES AFLD PIC Z(4).99-.
>
> When the program runs it gives an illegal value in NFLD when it executes
> the line 2348;
>
> MOVE NFLD TO PAID
>
> PAID is defined as (line 75);
>
> 77 PAID PIC S9(6)V99.
>
> It seems that the REDEFINES clause used in this manner with PIC will
> require the MF directive?
>
> Not sure where to place the directive and what syntax is required. We
> tried DIRECTIVE(MF) in the project options, but still get the same
> error. We also tried DIRECTIVE(MF) in the single compile options under
> tools, but still no luck.
>
> Any advice or ideas?
>
> Thanks
> Mark
>[/color]
--------------------------------------------------------------------------------
[color=darkred]
> IDENTIFICATION DIVISION.
> PROGRAM-ID. ECINV.
> AUTHOR. FMAR.
> ENVIRONMENT DIVISION.
> CONFIGURATION SECTION.
> SOURCE-COMPUTER. ICLPC.
> OBJECT-COMPUTER. ICLPC.
> SPECIAL-NAMES. CONSOLE IS CRT.
> INPUT-OUTPUT SECTION.
> FILE-CONTROL.
> COPY "ECCTLFD.LIB".
> COPY "ECSTKFD.LIB".
> COPY "ECTRXFD.LIB".
> COPY "ECDEBFD.LIB".
> COPY "ECPCLFD.LIB".
> COPY "ECPRTFD.LIB".
> DATA DIVISION.
> FILE SECTION.
> COPY "ECCTL.LIB".
> COPY "ECSTK.LIB".
> COPY "ECTRX.LIB".
> COPY "ECDEB.LIB".
> COPY "ECPCL.LIB".
> FD PRINT-FILE; RECORD 129.
> 01 PLINE.
> 03 PL01 PIC X(8).
> 03 PLS PIC X(17).
> 03 PD PIC X(34).
> 03 PQ PIC X(10).
> 03 PU PIC X(4).
> 03 PPRC PIC X(9).
> 03 PG PIC X(11).
> 03 FILLER PIC XX.
> 03 PDPP PIC X(6).
> 03 PDIS PIC X(10).
> 03 PVAT PIC X(10).
> 03 PVAL PIC X(11).
> 01 PL2.
> 03 PL21 PIC X(12).
> 03 PTIT PIC X(17).
> 03 PDREG PIC X(9).
> 03 PL21A PIC X(10).
> 03 PCUS PIC X(12).
> 03 PDTE PIC X(12).
> 03 PCHQ PIC X(7).
> 01 PL1.
> 03 PL11 PIC X(12).
> 03 PAD.
> 05 PCOD PIC X(5).
> 05 PTOWN PIC X(30).
> 05 PDLIT PIC X(18).
> 03 PCOOP PIC X(7).
> 03 PCSH PIC X(7).
> 01 PL3.
> 03 PL31 PIC X(6).
> 03 PBRN PIC X(20).
> 03 PTRM PIC X(9).
> 03 PTYPE PIC X(8).
> 03 PGRN PIC X(9).
> 03 PMDES PIC X(14).
> 03 PVATNO PIC X(12).
> WORKING-STORAGE SECTION.
> 77 PAYM PIC X.
> 77 CIND PIC X(7).
> 77 TIND PIC X(7).
>
> 77 PASS PIC X(6).
> 77 SPWD PIC X(6).
> 77 PPWD PIC X(6).
> 77 DIND PIC 9 VALUE 0.
> 77 SIND PIC 9 VALUE 0.
>
> 77 VAL PIC S9(6)V99.
> 77 DPRC PIC Z(6).99-.
> 77 PAID PIC S9(6)V99.
> 77 CHNG PIC S9(6)V99.
> 77 DIFF PIC S9(6)V99.
>
> 77 GROSS PIC Z(8).ZZ OCCURS 16.
> 77 DPP PIC ZZ.ZZ OCCURS 16.
> 77 TOTVAT PIC 9(8)V99.
> 77 VWRK1 PIC 9(8)V99.
> 77 VWRK2 PIC 9(8)V99.
> 77 TSUB PIC 99.
> 77 WSOR PIC X.
> 77 WLOR PIC X.
> 77 SFAC PIC 9V999.
> 77 DSFAC PIC 9V999.
> 77 DMFAC PIC 9V999.
> 77 USW PIC 9.
> 77 WEOD PIC 9(6) VALUE ZERO.
> 77 W01-NAME PIC X(25).
> 77 W01-ADR1 PIC X(25).
> 77 W01-ADR2 PIC X(20).
> 77 W01-ADR3 PIC X(15).
> 77 W01-PCOD PIC X(4).
> 77 W01-DREG PIC X(10).
> 77 W02-NAME PIC X(25).
> 77 W02-ADR1 PIC X(25).
> 77 W02-ADR2 PIC X(20).
> 77 W02-ADR3 PIC X(15).
> 77 W02-PCOD PIC X(4).
> 77 W01-MTYPE PIC X.
> 77 W01-VATNO PIC X(12).
> 77 DONE PIC 9.
> 77 WS-DPT PIC X(6).
> 77 LSP5 PIC S9(6)V99.
> 77 WRKV4 PIC S9(8)V9999.
> 77 WRK2V4 PIC S9(8)V9999.
> 77 LCST PIC S9(6)V99.
> 77 VAT PIC X.
> 77 BT PIC X(25).
> 77 CASHIN PIC S9(8)V99 OCCURS 8.
> 77 WBAL PIC S9(8)V99.
> 77 WTIM PIC 9.
> 77 CASH PIC X.
> 77 TOF PIC 99.
> 77 BOF PIC 99.
> 77 CON PIC XX.
> 77 OFFCON PIC XX.
> 77 BGROSS PIC S9(8)V99.
> 77 WGROSS PIC S9(8)V99.
> 77 PSW PIC 9 VALUE 1.
> 77 BRN PIC X(20).
> 77 LNECNT PIC 99.
> 77 DVAT PIC X(6).
> 77 VATPP PIC 999V99.
> 77 TOG PIC 9.
> 77 WT PIC 9 OCCURS 16.
> 77 IND1 PIC 9.
> 77 PIN1 PIC 9 OCCURS 16.
> 77 IND2 PIC 9.
> 77 PIN2 PIC 9 OCCURS 16.
> 77 IND3 PIC 9.
> 77 PIN3 PIC 9 OCCURS 16.
> 77 IND4 PIC 9.
> 77 IND5 PIC 9.
> 77 PIN5 PIC 9 OCCURS 16.
> 77 CVAL PIC S9(8)V99.
> 77 DISC PIC S9(8)V99.
> 77 Z6 PIC Z(6).
> 77 OSW PIC 9.
> 77 MUL PIC S9.
> 77 WS-RSEQ PIC 99.
> 77 ZDATE PIC 99/99/99.
> 77 SDES PIC X(12).
> 77 LNO PIC 99.
> 77 LLN PIC 99.
> 77 WNO PIC 99.
> 77 WS-SUB PIC 99.
> 77 SUBA PIC 999.
> 77 WS-FSTSW PIC 9 VALUE 1.
> 77 WS-TYP PIC 9.
> 77 S-TYP PIC 9.
> 77 NK PIC X VALUE SPACE.
> 77 RP PIC X.
> 77 BLANKDES PIC X(16) VALUE SPACE.
> 77 VLNG PIC 99.
> 77 WS-TJNL PIC 999.
> 77 WS-LASTJ PIC 999.
> 77 WS-BCH PIC 999.
> 77 LOK PIC 9(4).
> 77 SUB PIC 9999.
> 77 ZZ9V9 PIC ZZ9.9.
> 77 ZZZ PIC ZZZ.
> 77 BVAL PIC S9(8)V99.
> 77 BQTY PIC S9(8)V99.
> 77 BOTH PIC S9(8)V99.
> 77 BPP PIC 999V99.
> 77 WVAL PIC S9(8)V99.
> 77 WQTY PIC S9(8)V99.
> 77 WOTH PIC S9(8)V99.
> 77 ZZ PIC ZZ.
> 77 WRKS PIC 9(8)V99.
> 77 WRK PIC S9(8)V99.
> 77 WRK0 PIC S9(8)V99.
> 77 WRK1 PIC S9(8)V99.
> 77 WRK2 PIC S9(8)V99.
> 77 WRK3 PIC S9(8)V99.
> 77 LSUB PIC 9999.
> 77 Z5VZZ PIC Z(5).ZZ.
> 77 Z5VZZN PIC Z(5).ZZ-.
> 77 W5VZZN PIC ZZZZ9.99-.
> 77 Z6VZZN PIC Z(6).ZZ-.
> 77 Z6VZZ PIC Z(6).ZZ.
> 77 SPA REDEFINES Z6VZZ PIC X(9).
> 77 ZZVZZ PIC ZZ.ZZ.
> 77 Z7VZZ PIC Z(7).ZZ.
> 77 Z7VZZN PIC Z(7).ZZ-.
> 77 ACT PIC X.
> COPY "ECWS.LIB".
>
> 01 OKM.
> 05 OKM1 PIC X(3) VALUE "OK".
> 05 OKM2 PIC X(11) VALUE "? (Y/N) [ ]".
>
> 01 BRKT PIC X(12) VALUE "[ ]".
>
> 01 AFLD PIC X(8).
> 01 NFLD REDEFINES AFLD PIC Z(4).99-.
>
> 01 TSTRT PIC X(4) VALUE X"1B5B3574".
> 01 TSTOP PIC X(4) VALUE X"1B5B3674".
> 01 TOPEN PIC X(4) VALUE X"1B5B3174".
> 01 ZAMT.
> 05 TAMT PIC Z(4).99.
> 05 TSIG PIC X.
> 01 TACT.
> 05 TCTL PIC X VALUE X"02".
> 05 TPFX PIC XX VALUE SPACES.
> 05 TVAL PIC X(7).
> 05 TCHR PIC X.
>
> 01 ACDTE.
> 05 ACD PIC 99.
> 05 FILLER PIC X VALUE "/".
> 05 ACM PIC 99.
> 05 FILLER PIC X VALUE "/".
> 05 ACY PIC 9(4).
>
> 01 WPDS.
> 03 PDS PIC X(30) OCCURS 16.
> 03 PUN PIC XXX OCCURS 16.
>
> 01 VATTBL.
> 03 VATTOT PIC 9(6)V99 OCCURS 16.
>
> 01 AMTTBL.
> 05 PLSP5 PIC S9(6)V99 OCCURS 16.
> 05 PLCST PIC S9(6)V99 OCCURS 16.
> 05 WC PIC S9(8)V99 OCCURS 16.
> 05 WD PIC S9(8)V99 OCCURS 16.
>
> 01 VATPC.
> 03 VATPCL OCCURS 16.
> 05 VATGRP PIC X.
> 05 FILLER PIC X.
> 05 VATCLS PIC XX.
> 05 FILLER PIC XX.
> 01 CUSSUF.
> 02 CUS PIC X(6).
> 02 SUF PIC X.
> 01 RTOTAL PIC 9(8)V99.
> 01 ROUNDD REDEFINES RTOTAL.
> 03 RRANDS PIC 9(8).
> 03 RCENT1 PIC 9.
> 03 RCENT2 PIC 9.
> 01 PAG.
> 03 PLIN OCCURS 16.
> 05 PLSTK PIC X(15).
> 05 FILLER PIC X.
> 05 PLQTY PIC ZZZZZZ.99-.
> 05 FILLER PIC X.
> 05 PLSP PIC ZZZZZ9.99.
> 05 FILLER PIC XX.
> 05 PLDIS PIC ZZZZZZ.99-.
> 05 FILLER PIC X.
> 05 PLVAT PIC Z(6).99-.
> 05 FILLER PIC XX.
> 05 PLVAL PIC ZZZZZZ9.99-.
> 05 FILLER PIC XX.
> 05 PLNO PIC 99.
> 01 LIN.
> 05 LSTK PIC X(15).
> 05 FILLER PIC X.
> 05 LQTY PIC ZZZZZZ.99-.
> 05 FILLER PIC X.
> 05 LSP PIC ZZZZZ9.99.
> 05 FILLER PIC XX.
> 05 LDIS PIC ZZZZZZ.99-.
> 05 FILLER PIC X.
> 05 LVAT PIC Z(6).99-.
> 05 FILLER PIC XX.
> 05 LVAL PIC ZZZZZZ9.99-.
> 05 FILLER PIC XX.
> 05 LLNO PIC 99.
> 01 DESC.
> 02 FILLER PIC X(78) VALUE " Account Date Ref
> - " OK?".
> 01 TR1 REDEFINES DESC.
> 02 T1 PIC X(78) OCCURS 1.
> 01 D2.
> 02 FILLER PIC X(78) VALUE " Stock Number Quantity Unit Pr
> - "ice Discount Vat Value OK?".
> 01 TR2 REDEFINES D2.
> 02 T2 PIC X(78) OCCURS 1.
> 01 WS-KEY.
> 03 WS-CO PIC XX VALUE SPACE.
> 03 WS-STKNO PIC X(15).
> 03 WS-RTYP PIC 999.
> 01 WS-DEPT.
> 05 WS-GR1 PIC X.
> 05 WS-GR2 PIC X.
> 05 WS-CLS PIC X(4).
> 01 WS-CKEY.
> 03 FILLER PIC XX.
> 03 FILLER PIC X(7).
> 03 WS-CRTYP PIC 999.
> 01 WS-DATE PIC 9(6).
> 01 WS-SPLITDATE REDEFINES WS-DATE.
> 03 WS-DAY PIC 99.
> 03 WS-MON PIC 99.
> 03 WS-YR PIC 99.
> 01 WS-DESTBL.
> 03 FILLER PIC X(28) VALUE "INVOICES".
> 01 WS-RES REDEFINES WS-DESTBL.
> 03 WS-TRXDES PIC X(14) OCCURS 2.
> 01 WS-POS.
> 03 WS-VPOS PIC 99.
> 03 WS-HPOS PIC 99.
> 01 VS-P1.
> 03 VS-VP1 PIC 99.
> 03 VS-HP1 PIC 99.
> 01 VS-P2.
> 03 VS-VP2 PIC 99.
> 03 VS-HP2 PIC 99.
> 01 PPOS.
> 03 POSV PIC 99.
> 03 POSH PIC 99.
> COPY "ECINV.DDS".
> LINKAGE SECTION.
> COPY "ECLINK.LIB".
> PROCEDURE DIVISION USING SDT SCO WSU SCR TRM PTYP PLNS.
> MAIN SECTION.
> ROOTA.
> MOVE ZERO TO DPRC VLNG PAID.
> PERFORM TRMSET.
> OPENIT.
> PERFORM CTLO.
> PERFORM DEBO.
> PERFORM PCLO.
> PERFORM STKO.
> PERFORM TRXO.
> R-INIT.
> PERFORM A000-INIT.
> IF OK = "E "
> GO TO CLOSEIT.
> R-SC.
> PERFORM M-SCREEN.
> IF CUS = "E "
> PERFORM CLOSEIT
> GO TO OPENIT.
> PERFORM PROC1.
> PERFORM PROC2.
> PERFORM PROC3.
> PERFORM PROC4.
> PERFORM CLOSEIT.
> R-REP.
> DISPLAY "REPRINT INVOICE (Y/N) [N]" AT 1320.
> MOVE "N" TO RP.
> ACCEPT RP AT 1343.
> DISPLAY CLR AT 1302.
> IF RP = "Y"
> PERFORM PROC3 GO TO R-REP
> ELSE
> PERFORM OPENIT
> GO TO R-SC.
> SC-TRNOUT.
> IF WT(SUB) = 4
> GO TO SC-JNL.
> MOVE 300 TO WS-RTYP.
> MOVE ZERO TO WS-RSEQ.
> SC-TREAD.
> COMMIT.
> READ ECSTK NEXT KEPT LOCK
> AT END GO TO SC-TRNEW.
> MOVE FSTK TO STAT.
> PERFORM STCHK.
> IF LKC = "R"
> GO TO SC-TREAD.
> IF STK-TYP < 300
> IF TRX-STK = STK-STKNO
> GO TO SC-TRUPD.
> SC-TRNEW.
> COMMIT.
> MOVE ALL ZEROES TO RSB-STK.
> MOVE WS-KEY TO STK-KEY.
> MOVE WS-RTYP TO STK-TYP.
> MOVE WS-RSEQ TO STK-SEQ.
> SUBTRACT 1 FROM STK-TYP.
> MOVE STK-KEY TO WS-KEY.
> SC-TWR.
> PERFORM STKW1 THRU FL9.
> SC-TGET.
> MOVE WS-KEY TO STK-KEY.
> MOVE 2 TO CHK.
> PERFORM STK1 THRU FL9.
> SC-TRUPD.
> IF STK-SEQ NOT < 12
> MOVE STK-TYP TO WS-RTYP
> GO TO SC-TRNEW.
> ADD 1 TO STK-SEQ.
> MOVE STK-SEQ TO WS-SUB.
> MOVE S-TYP TO RSB-TYP(WS-SUB).
> MOVE CUS TO RSB-ACNO(WS-SUB).
> MOVE SUF TO RSB-ACSUF(WS-SUB).
> MOVE TRX-REF TO RSB-REF(WS-SUB).
> MOVE TRX-DAT TO RSB-DAT(WS-SUB).
> MOVE TRX-AMT(1) TO RSB-QTY(WS-SUB).
> MOVE TRX-JNL TO RSB-JNL(WS-SUB).
> MOVE TRX-AMT(4) TO RSB-CVAL(WS-SUB).
> MOVE TRX-AMT(8) TO RSB-SVAL(WS-SUB).
> SC-TRW.
> PERFORM STKR1 THRU FL9.
> COMMIT.
> SC-JNL.
> ADD 1 TO TRX-TRX.
> MOVE 4 TO TRX-TYP.
> MOVE "TS" TO TRX-RTYP.
> SC-WR.
> PERFORM TRXW1 THRU FL9.
> MOVE ZERO TO TRX-AMT(1) TRX-AMT(2) TRX-AMT(3) TRX-AMT(4)
> TRX-AMT(5) TRX-AMT(6) TRX-AMT(7) TRX-AMT(8)
> TRX-AMT(9) TRX-IND(1) TRX-IND(2) TRX-IND(3)
> TRX-IND(4) TRX-PIND.
> SC-TRXT.
> COMMIT.
> EXIT.
> SC-CLR.
> DISPLAY CLR AT WS-POS.
> IF WS-VPOS < 22
> ADD 1 TO WS-VPOS
> GO TO SC-CLR.
> SC-CL1.
> DISPLAY CLR AT 2402.
> CLOSEIT.
> COMMIT.
> CLOSE ECCTL ECSTK ECTRX ECDEB ECPCL.
> A999.
> DISPLAY SPACE.
> EXIT PROGRAM.
> STOP RUN.
> R-X.
> EXIT.
> M-SCREEN SECTION.
> COMMIT.
> PERFORM CTLRD.
> ADD 1 WSU GIVING WS-SUB.
> MOVE C00-CASHIN(1) TO CASHIN(1).
> MOVE C00-CASHIN(2) TO CASHIN(2).
> MOVE C00-CASHIN(3) TO CASHIN(3).
> MOVE C00-CASHIN(4) TO CASHIN(4).
> MOVE C00-CASHIN(5) TO CASHIN(5).
> MOVE C00-CASHIN(6) TO CASHIN(6).
> MOVE C00-CASHIN(7) TO CASHIN(7).
> MOVE C00-CASHIN(8) TO CASHIN(8).
> IF PTYP = 1
> MOVE C00-CONPRT-1 TO CON
> MOVE C00-NORPRT-1 TO OFFCON.
> IF PTYP = 2
> MOVE C00-CONPRT-2 TO CON
> MOVE C00-NORPRT-2 TO OFFCON.
> IF PTYP = 3
> MOVE C00-CONPRT-3 TO CON
> MOVE C00-NORPRT-3 TO OFFCON.
> MOVE C00-ITOF (PTYP) TO TOF.
> MOVE C00-IBOF (PTYP) TO BOF.
> MOVE C00-SFAC TO SFAC.
> MOVE C00-SPWD TO SPWD.
> MOVE C00-PPWD TO PPWD.
> SC-START.
> COMMIT.
> MOVE ZERO TO BQTY BVAL BOTH BPP WQTY WVAL WOTH BGROSS DIND.
> DISPLAY SPACE.
> IF TRM > 1
> DISPLAY GRON.
> DISPLAY GR.
> IF TRM > 1
> DISPLAY GROFF.
> PERFORM HD.
> DISPLAY LH1 AT 0202.
> DISPLAY LH2 AT 0502.
> MOVE SPACE TO TRX-OREF.
> MOVE ZERO TO TRX-DAT WRK.
> ASUP.
> MOVE ZERO TO IND4 TRX-IND(4).
> MOVE SPACE TO CUSSUF.
> MOVE 0603 TO WS-POS VS-P1 VS-P2.
> PERFORM VW7 THRU VW-X.
> DISPLAY CUSSUF AT 0603.
> ACCEPT CUSSUF AT 0603.
> PERFORM VRUB.
> IF CUS = "E"
> GO TO SC-X.
> IF CUS NOT = "T"
> GO TO AGET.
> DISPLAY CLR AT 2202.
> MOVE SPACE TO PASS.
> DISPLAY "Enter Password :" AT 2220.
> IF TRM < 2
> CALL X"AF" USING HV1, HV2.
> IF TRM = 2
> DISPLAY BFLDI AT 2239.
> IF TRM > 2
> DISPLAY BFLDO AT 2239.
> ACCEPT PASS AT 2240.
> IF TRM > 1
> DISPLAY NRMO AT 2239.
> IF PASS NOT = SPACE
> IF PASS = SPWD
> GO TO TILL.
> DISPLAY CLR AT 2202.
> GO TO ASUP.
> TILL.
> IF WSU > 1
> GO TO ASUP.
> MOVE "User Takings" TO BT.
> PERFORM BX1.
> MOVE ZERO TO WTIM WRK.
> MOVE 1 TO SUB.
> TIL1.
> IF SUB > 8
> GO TO TILX.
> MOVE CASHIN(SUB) TO W5VZZN.
> SUBTRACT 1 FROM SUB GIVING WTIM.
> ADD CASHIN(SUB) TO WRK.
> ADD 5 TO LOK.
> DISPLAY WTIM AT LOK.
> ADD 12 TO LOK.
> DISPLAY W5VZZN AT LOK.
> ADD 83 TO LOK.
> IF TRM > 1
> DISPLAY GRON.
> DISPLAY EDGE AT LOK.
> IF TRM > 1
> DISPLAY GROFF.
> ADD 1 TO SUB.
> GO TO TIL1.
> TILX.
> ADD 100 TO LOK.
> IF TRM > 1
> DISPLAY GRON.
> DISPLAY ACC2 AT LOK.
> IF TRM > 1
> DISPLAY GROFF.
> SUBTRACT 95 FROM LOK.
> DISPLAY "TOTAL :" AT LOK.
> ADD 12 TO LOK.
> MOVE WRK TO W5VZZN.
> DISPLAY W5VZZN AT LOK.
> DISPLAY "Hit ENTER to continue.." AT 2220.
> ACCEPT OK AT 2270.
> MOVE 1002 TO WS-POS.
> PERFORM SC-CLR.
> GO TO ASUP.
> AGET.
> MOVE WS-CO TO DEB-CO.
> MOVE CUS TO DEB-ACNO.
> MOVE SUF TO DEB-ACSUF.
> MOVE 100 TO DEB-RTYP.
> IF CUS NOT = SPACE
> IF SUF = SPACE
> GO TO SCAN.
> MOVE 1 TO CHK.
> PERFORM DEB1 THRU FL9.
> IF CHK = 1
> GO TO ASUP.
> IF DEB-MTYPE = "B"
> DISPLAY "BRANCH ACCOUNT" AT 0953
> GO TO ASUP.
> DISPLAY DEB-NAME AT 0903.
> DISPLAY "MEMBER" AT 0953.
> IF DEB-MTYPE = "N"
> DISPLAY "NON-MEMBER" AT 0953.
> IF DEB-MTYPE = "X"
> DISPLAY "NON-MEMBER" AT 0953.
> IF DEB-MTYPE = "Z"
> DISPLAY "NON-MEMBER" AT 0953.
> IF DEB-MTYPE = "S"
> DISPLAY "NON-MEMBER" AT 0953.
> DISPLAY DEB-VATNO AT 0965.
> IF DEB-RNAME > SPACES
> PERFORM FFD
> PERFORM MCOM
> PERFORM HD.
> MOVE DEB-NAME TO W01-NAME.
> MOVE DEB-ADR1 TO W01-ADR1.
> MOVE DEB-ADR2 TO W01-ADR2.
> MOVE DEB-ADR3 TO W01-ADR3.
> MOVE DEB-PCOD TO W01-PCOD.
> MOVE DEB-DREG TO W01-DREG.
> MOVE DEB-MTYPE TO W01-MTYPE.
> MOVE DEB-VATNO TO W01-VATNO.
> GO TO ABDAT.
> SCAN.
> START ECDEB KEY > DEB-KEY
> INVALID DISPLAY "ACCOUNT DOES NOT EXIST " AT 2202
> ACCEPT OK AT 2270
> DISPLAY CLR AT 2202
> GO TO ASUP.
> COMMIT.
> MOVE "TYPE AVAILABLE " TO BT.
> PERFORM BX1.
> SR.
> READ ECDEB NEXT
> AT END GO TO ASUF.
> MOVE FDEB TO STAT.
> PERFORM STCHK.
> IF LKC = "R"
> GO TO SR.
> IF CUS NOT = DEB-ACNO
> GO TO ASUF.
> IF DEB-RTYP NOT = 100
> GO TO SR.
> ADD 5 TO LOK.
> DISPLAY DEB-ACSUF AT LOK.
> MOVE ZERO TO Z6VZZN WBAL.
> SUBTRACT DEB-CBAL FROM DEB-CRLIM GIVING Z6VZZN WBAL.
> IF WBAL < ZERO
> MOVE ZERO TO WBAL Z6VZZN.
> ADD 11 TO LOK.
> DISPLAY Z6VZZN AT LOK.
> ADD 84 TO LOK.
> IF TRM > 1
> DISPLAY GRON.
> DISPLAY EDGE AT LOK.
> IF TRM > 1
> DISPLAY GROFF.
> GO TO SR.
> BX1.
> IF TRM > 1
> DISPLAY GRON.
> PERFORM FFD.
> DISPLAY ACC1 AT 1015.
> DISPLAY EDGE AT 1115.
> IF TRM > 1
> DISPLAY GROFF.
> PERFORM HD.
> DISPLAY BT AT 1118.
> PERFORM FFD.
> MOVE 1215 TO LOK.
> IF TRM > 1
> DISPLAY GRON.
> DISPLAY EDGE AT LOK.
> IF TRM > 1
> DISPLAY GROFF.
> ASUF.
> ADD 100 TO LOK.
> IF TRM > 1
> DISPLAY GRON.
> DISPLAY ACC2 AT LOK.
> IF TRM > 1
> DISPLAY GROFF.
> SUBTRACT 96 FROM LOK.
> PERFORM HD.
> DISPLAY "[ ] Select Account Type" AT LOK.
> PERFORM FFD.
> ADD 1 TO LOK.
> MOVE SPACE TO OK.
> ACCEPT OK AT LOK.
> MOVE OK TO SUF.
> MOVE 1002 TO WS-POS.
> PERFORM SC-CLR.
> DISPLAY SUF AT 0609.
> GO TO AGET.
> ABDAT.
> MOVE 0616 TO WS-POS.
> PERFORM VW6 THRU VW-X.
> MOVE SDT TO WS-DATE.
> ACCEPT WS-DATE AT 0616.
> MOVE WS-DATE TO NDTE.
> PERFORM DTCHK.
> IF CHK = 1
> GO TO ABDAT.
> MOVE WS-DATE TO ZDATE TRX-DAT.
> DISPLAY ZDATE AT 0615.
>
> MOVE ND TO ACD.
> MOVE NM TO ACM.
> MOVE NY TO ACY.
> IF NY > 84
> ADD 1900 TO ACY
> ELSE
> ADD 2000 TO ACY.
>
> AGRN.
> MOVE 0627 TO WS-POS.
> MOVE ZERO TO Z6.
> DISPLAY Z6 AT WS-POS.
> ACSH.
> MOVE ZERO TO WBAL.
> PERFORM HD.
> DISPLAY "Cash/Account ? [ ]" AT 0635.
> PERFORM FFD.
> DISPLAY "C" AT 0635.
> DISPLAY "A" AT 0640.
> MOVE SPACE TO OK.
> ACCEPT OK AT 0651.
> IF OK NOT = "C"
> IF OK NOT = "A"
> GO TO ACSH.
> MOVE OK TO CASH.
> DISPLAY " " AT 0635.
> IF CASH = "C"
> DISPLAY "CASH SALE" AT 0538
> ELSE
> DISPLAY "INVOICE" AT 0538.
> IF CASH NOT = "A"
> UNLOCK ECDEB
> GO TO ABOK.
> SUBTRACT DEB-CBAL FROM DEB-CRLIM GIVING WBAL Z6VZZN.
> IF DEB-CRLIM = 1
> PERFORM CRLN
> ACCEPT OK AT 0675
> GO TO SC-START.
> IF WBAL = ZERO
> PERFORM CRLA
> GO TO ABLOV.
> IF WBAL < ZERO
> PERFORM CRLM
> GO TO ABLOV.
> ABDISL.
> PERFORM HD.
> DISPLAY "Avail.Cr Doc.Value" AT 0553.
> PERFORM FFD.
> DISPLAY Z6VZZN AT 0652.
> GO TO ABOK.
> ABLOV.
> MOVE "N" TO OK.
> DISPLAY "[N]" AT 0677.
> IF WLOR NOT = "N"
> ACCEPT OK AT 0678
> ELSE
> ACCEPT NK AT 0678.
> IF OK = "N"
> GO TO SC-START.
> DISPLAY " " AT 0650.
> GO TO ABDISL.
> ABOK.
> MOVE "Y" TO OK.
> MOVE 0678 TO WS-POS.
> PERFORM HD.
> DISPLAY OK AT WS-POS.
> PERFORM FFD.
> PERFORM VW1 THRU VW-X.
> ACCEPT OK AT 0678.
> IF OK = "N"
> GO TO SC-START.
> IF OK NOT = "Y"
> GO TO ABOK.
> DISPLAY OK AT WS-POS.
> PERFORM HD.
> DISPLAY LH3 AT 0902.
> PERFORM FFD.
> MOVE 1 TO LNO.
> MOVE 1203 TO PPOS.
> MOVE SPACE TO PAG LIN WPDS.
> MOVE 1 TO SUB.
> ABOK1.
> MOVE ZERO TO PLSP5 (SUB) PLCST (SUB) WC (SUB) WD (SUB).
> MOVE ZERO TO VATTOT (SUB).
> ADD 1 TO SUB.
> IF SUB < 17
> GO TO ABOK1.
>
> MOVE 1002 TO WS-POS.
> PERFORM SC-CLR.
> MOVE "C" TO ACT.
> SC-ACT.
> MOVE ZERO TO WRK WRK0 WRK1 WRK2 WRK3 TOG CVAL DISC
> TRX-AMT(1) TRX-AMT(2) TRX-AMT(3) TRX-AMT(4)
> TRX-AMT(5) TRX-AMT(6) TRX-AMT(7) TRX-AMT(8)
> TRX-AMT(9) IND1 IND2 IND3 IND5 LCST.
> MOVE SPACE TO LIN.
> MOVE "C" TO ACT.
> DISPLAY CLR AT 1002.
> DISPLAY CLR AT 1102.
> PERFORM HD.
> DISPLAY "ACTION: [ ]" AT 1102.
> PERFORM FFD.
> DISPLAY ACT AT 1111.
> ACCEPT ACT AT 1111.
> IF ACT = "C"
> IF LNO > 15
> DISPLAY "No further line items permitted !" AT 2202
> ACCEPT OK AT 2270
> DISPLAY CLR AT 2202
> GO TO SC-ACT.
> IF ACT = "B"
> GO TO SC-BCHEND.
> IF ACT = "E"
> GO TO SC-BCHEND.
> IF ACT = "C"
> GO TO SC-STK.
> IF PLSTK(1) = SPACE
> GO TO SC-ACT.
> IF ACT = "A"
> GO TO SC-STK.
> IF ACT NOT = "D"
> GO TO SC-ACT.
> SC-D.
> PERFORM HD.
> DISPLAY "DELETE LINE NO [ ]" AT 1002.
> PERFORM FFD.
> MOVE ZERO TO ZZ WNO.
> ACCEPT ZZ AT 1018.
> MOVE ZZ TO WNO.
> MOVE WNO TO ZZ.
> DISPLAY ZZ AT 1018.
> IF WNO < 1
> GO TO SC-ACT.
> IF WNO > 15
> GO TO SC-D.
> IF PLSTK(WNO) = SPACE
> GO TO SC-D.
> MOVE PLSTK(WNO) TO LSTK.
> DISPLAY LSTK AT 1025.
> GO TO SC-OK.
> SC-STK.
> MOVE SPACE TO TRX-STK.
> MOVE 1003 TO WS-POS VS-P1 VS-P2.
> DISPLAY TRX-STK AT WS-POS.
> PERFORM HD.
> IF TOG = 4
> DISPLAY "Prd.Clss " AT 0903
> PERFORM VW6 THRU VW-X
> ELSE
> DISPLAY "Stock Number" AT 0903
> PERFORM VW15 THRU VW-X.
> PERFORM FFD.
> ACCEPT TRX-STK AT WS-POS.
> PERFORM VRUB.
> IF TRX-STK = SPACES
> GO TO SC-TOG.
> IF TRX-STK = "B"
> GO TO SC-BCHEND.
> IF TOG = 4
> IF TRX-STK < "S"
> DISPLAY "GROUP CODE NOT ALLOWED !!" AT 2202
> ACCEPT OK AT 2270
> DISPLAY CLR AT 2202
> GO TO SC-STK.
> IF DEB-DREG NOT = SPACES
> GO TO SC-RD.
> IF TRX-STK NOT = "02000020"
> IF TRX-STK NOT = "02000044"
> GO TO SC-RD.
> DISPLAY "NO DIESEL REGISTRATION NUMBER !!" AT 2202.
> ACCEPT OK AT 2270.
> DISPLAY CLR AT 2202.
> GO TO SC-STK.
> SC-RD.
> MOVE WS-CO TO STK-CO PCL-CO.
> MOVE TRX-STK TO STK-STKNO PCL-DPT LSTK WS-DEPT.
> MOVE 100 TO STK-TYP PCL-TYP.
> IF TOG = 4
> IF WS-CLS = SPACES
> DISPLAY "INVALID GROUP CODE !!" AT 2202
> ACCEPT OK AT 2270
> DISPLAY CLR AT 2202
> GO TO SC-STK.
> IF TOG = 4
> GO TO SC-PCL.
> MOVE 1 TO CHK.
> PERFORM STK1 THRU FL9.
> IF CHK = 1
> GO TO SC-NOTSTK.
> GO TO SC-GOTSTK.
> SC-NOTSTK.
> DISPLAY "INVALID STOCK ID.!" AT 2209.
> ACCEPT OK AT 2230.
> DISPLAY CLR AT 2202.
> GO TO SC-STK.
> SC-TOG.
> IF TOG = 4
> MOVE ZERO TO TOG
> ELSE
> MOVE 4 TO TOG.
> GO TO SC-STK.
> SC-PCL.
> MOVE 3 TO CHK.
> PERFORM PCL1 THRU FL9.
> IF CHK = 1
> GO TO SC-STK.
> MOVE SPACE TO STK-STKNO STK-VAT STK-STYP STK-DSC STK-UNIT.
> MOVE ZERO TO STK-CPPRC(1) STK-SP1 STK-SP2.
> MOVE PCL-DESC TO STK-DESC.
> MOVE PCL-DPT TO STK-DPT.
> MOVE ZERO TO DSFAC DMFAC.
> IF PCL-DSMUP > ZERO
> DIVIDE 100 INTO PCL-DSMUP GIVING DSFAC.
> ADD 1 TO DSFAC.
> IF PCL-DMMUP > ZERO
> DIVIDE 100 INTO PCL-DMMUP GIVING DMFAC.
> ADD 1 TO DMFAC.
> SC-GOTSTK.
> MOVE STK-DPT TO WS-DPT.
> MOVE STK-KEY TO WS-KEY.
> DISPLAY STK-DESC AT 1120.
> IF TOG = 4
> GO TO SC-SCHK.
> MOVE LNO TO TSUB.
> SC-DTST.
> SUBTRACT 1 FROM TSUB.
> IF TSUB = ZERO
> GO TO SC-SCHK.
> IF PLSTK(TSUB) = TRX-STK
> PERFORM SDUP
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> GO TO SC-ACT.
> GO TO SC-DTST.
> SC-SCHK.
> IF STK-DPT = "K D0 "
> PERFORM SCRP
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147.
> IF STK-DPT = "K D0C "
> PERFORM SCRP
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147.
> IF STK-DPT = "B H0 "
> PERFORM ECYL
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147.
> IF TRX-STK NOT = "93021285"
> IF TRX-STK NOT = "93021359"
> GO TO SC-POIS.
> PERFORM EBOT.
> ACCEPT OK AT 1178.
> DISPLAY CLRM AT 1147.
> SC-POIS.
> IF STK-STYP = "P"
> MOVE 1 TO IND5.
> IF STK-STYP = "P"
> PERFORM POIS.
> PERFORM FFD.
> IF TOG = 4
> ACCEPT STK-DESC AT 1120.
> DISPLAY STK-UNIT AT 1115.
> PERFORM FFD.
> SC-QTY.
> MOVE 1019 TO WS-POS.
> MOVE ZERO TO Z6VZZ.
> PERFORM HD.
> PERFORM VW9 THRU VW-X.
> PERFORM FFD.
> ACCEPT Z6VZZ AT WS-POS.
> PERFORM VRUB.
> MOVE Z6VZZ TO WRK0.
> IF WRK0 = ZERO
> GO TO SC-STK.
> MOVE WRK0 TO Z6VZZ LQTY.
> IF TOG NOT = 4
> IF WRK0 > STK-CQTY
> DISPLAY "Insufficient( )?[N]" AT 1152
> MOVE STK-CQTY TO Z6VZZN
> DISPLAY Z6VZZN AT 1165
> MOVE "N" TO OK
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> PERFORM SC-SOR
> IF OK = "N"
> GO TO SC-ACT
> ELSE
> NEXT SENTENCE.
> SUBTRACT WRK0 FROM STK-CQTY GIVING WRK.
> * IF TOG NOT = 4
> * IF WRK < STK-REORD
> * DISPLAY "Stock below Reorder " AT 1153.
> DISPLAY Z6VZZ AT WS-POS.
> GO TO SC-PRC.
> SC-SOR.
> IF OK = "Y"
> IF WSOR = "Y"
> MOVE "Y" TO OK
> ELSE
> MOVE "N" TO OK
> ELSE
> MOVE "N" TO OK.
> SC-PRC.
> MOVE 1030 TO WS-POS.
> IF TOG = 4
> IF PCL-DPT = "X VAT "
> * PERFORM SC-COST
> * MOVE "N" TO STK-DSC
> GO TO SC-PPP.
> IF TOG = 4
> IF WS-GR1 NOT = "U"
> PERFORM SC-COST.
> SC-PPP.
> IF DEB-MTYPE = "S"
> PERFORM SC-STAFF.
> PERFORM HD.
> PERFORM VW9 THRU VW-X.
> IF DEB-MTYPE NOT = "S"
> IF TOG = 4
> MOVE STK-SP1 TO Z6VZZ
> ELSE
> MOVE STK-SP1 TO Z6VZZ
> ELSE
> MOVE STK-SP1 TO Z6VZZ.
> DISPLAY Z6VZZ AT WS-POS.
> PERFORM FFD.
> IF TOG = 4
> * IF WS-GR1 = "U" OR "T"
> MOVE SPACE TO SPA
> ACCEPT SPA AT WS-POS
> MOVE Z6VZZ TO WRK
> IF WRK < STK-SP1
> GO TO SC-PPP.
> IF TOG = 4
> IF SPA = SPACE
> IF DEB-MTYPE NOT = "S"
> GO TO SC-PPP.
> MOVE Z6VZZ TO WRK.
> IF WRK < ZERO
> GO TO SC-PPP.
> IF SPA = SPACE
> MOVE STK-SP1 TO WRK LSP
> ELSE
> MOVE WRK TO LSP.
> DISPLAY LSP AT WS-POS.
> IF TOG = 4
> IF WRK < LCST
> PERFORM PRCC
> MOVE "N" TO OK
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> GO TO SC-PPP.
> PERFORM VRUB.
> MULTIPLY WRK0 BY WRK GIVING WRKV4 WRK3 ROUNDED.
> IF STK-STYP = "S"
> DIVIDE 100 INTO WRKV4 GIVING WRK3 ROUNDED WRKV4 ROUNDED.
> MOVE WRK3 TO Z6VZZ WGROSS.
> DISPLAY Z6VZZ AT 1064.
> MOVE ZERO TO WRK2.
> GO TO SC-DIS.
> SC-COST.
> PERFORM HD.
> DISPLAY "Cost" AT 0930.
> PERFORM VW9 THRU VW-X.
> MOVE ZERO TO Z6VZZ.
> PERFORM FFD.
> ACCEPT Z6VZZ AT WS-POS.
> MOVE Z6VZZ TO WRK.
> IF WRK NOT > ZERO
> GO TO SC-COST.
> DISPLAY Z6VZZ AT WS-POS.
> MOVE WRK TO LCST.
> MOVE ZERO TO CVAL.
> MULTIPLY DSFAC BY LCST GIVING STK-SP1 ROUNDED.
> MULTIPLY DMFAC BY LCST GIVING STK-SP2 ROUNDED.
> MULTIPLY WRK0 BY WRK GIVING CVAL.
> DISPLAY "Unit" AT 0930.
> SC-STAFF.
> MOVE ZERO TO STK-SP1.
> IF TOG = 4
> MULTIPLY SFAC BY LCST GIVING STK-SP1 ROUNDED
> ELSE
> MULTIPLY SFAC BY STK-CPPRC(1) GIVING STK-SP1 ROUNDED.
> SC-DIS.
> MOVE ZERO TO ZZVZZ.
> IF STK-DSC = "N"
> GO TO SC-PCHK.
> IF DEB-DISC = "N"
> GO TO SC-PCHK.
> IF TOG = 4
> MOVE SPACE TO DEB-VATNO.
> * IF TOG = 4
> * IF PCL-DPT NOT = "SBA0 "
> * GO TO SC-PCHK.
> PERFORM HD.
> DISPLAY " % " AT 0946.
> PERFORM FFD.
> MOVE 1041 TO WS-POS.
> PERFORM VW5 THRU VW-X.
> ACCEPT ZZVZZ AT WS-POS.
> PERFORM VRUB.
> PERFORM HD.
> DISPLAY "ount" AT 0946.
> PERFORM FFD.
> MOVE ZZVZZ TO WRK.
> MOVE WRK TO LDIS.
> IF TRX-STK NOT = "02000020"
> IF TRX-STK NOT = "02000044"
> GO TO SC-DIS1.
> IF WRK = ZERO
> DISPLAY "DISCOUNT ON DIESEL MUST BE ENTERED !!" AT 2202
> ACCEPT OK AT 2270
> DISPLAY CLR AT 2202
> GO TO SC-DIS.
> SC-DIS1.
> IF WRK = ZERO
> DISPLAY LDIS AT WS-POS
> GO TO SC-PCHK.
> MULTIPLY WRK BY WRKV4 GIVING WRK2V4 ROUNDED.
> DIVIDE 100 INTO WRK2V4 GIVING WRK2 ROUNDED LDIS ROUNDED
> WRK2V4 ROUNDED.
> DISPLAY LDIS AT WS-POS.
> SUBTRACT WRK2 FROM WRK3.
> SUBTRACT WRK2V4 FROM WRKV4.
> SC-PCHK.
> MOVE ZERO TO SIND.
> IF STK-SP2 > STK-SP1
> MOVE 1 TO SIND.
> IF STK-SP2 NOT > STK-CPPRC (1)
> MOVE 1 TO SIND.
> IF STK-STYP = "S"
> MULTIPLY 100 BY WRKV4.
> DIVIDE WRK0 INTO WRKV4 GIVING WRK1 ROUNDED.
> MOVE WRK1 TO LSP5.
> IF DEB-MTYPE = "S"
> IF WRK1 < STK-SP1
> PERFORM PRCM
> MOVE "N" TO OK
> DISPLAY OK AT 1178
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> GO TO SC-ACT.
> IF TOG = 4
> IF PCL-DPT NOT = "SBA0 "
> IF WRK1 < LCST
> PERFORM PRCC
> MOVE "N" TO OK
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> GO TO SC-ACT.
> IF TOG = 4
> IF PCL-DPT NOT = "SBA0 "
> IF WRK1 < STK-SP2
> PERFORM PRCM
> MOVE "N" TO OK
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> GO TO SC-ACT.
> IF TOG = 4
> GO TO SC-VAT.
> IF DEB-MTYPE NOT = "S"
> IF SIND = 1
> IF WRK1 < STK-SP1
> PERFORM PRCM
> MOVE "N" TO OK
> DISPLAY OK AT 1178
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> GO TO SC-ACT.
> IF DEB-MTYPE NOT = "S"
> IF SIND = 0
> IF WRK1 < STK-SP2
> PERFORM PRCM
> MOVE "N" TO OK
> DISPLAY OK AT 1178
> ACCEPT OK AT 1178
> DISPLAY CLRM AT 1147
> GO TO SC-ACT.
> IF WRK1 NOT = STK-SP1
> MOVE 1 TO IND1
> ELSE
> MOVE ZERO TO IND1.
> MOVE WRK3 TO Z6VZZ.
> DISPLAY Z6VZZ AT 1064.
> SC-VAT.
> MOVE 56 TO WS-HPOS.
> PERFORM HD.
> PERFORM VW1 THRU VW-X.
> MOVE SPACE TO OK.
> IF STK-VAT = "N"
> MOVE "N" TO OK
> ELSE
> MOVE "Y" TO OK.
> IF TOG = 4
> MOVE "Y" TO OK.
> IF TOG = 4
> IF PCL-VAT = "N"
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-GRP = "A " OR "C "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-GRP = "D " OR "F "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-GRP = "Q "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-DPT = "H A0 " OR "H E0 "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-DPT = "H J0 " OR "H K0 "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-DPT = "H A0C " OR "H E0C "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-DPT = "H J0C " OR "H K0C "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-DPT = "H A0D " OR "H E0D "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-DPT = "H J0D " OR "H K0D "
> IF W01-VATNO NOT = SPACES
> MOVE "N" TO OK.
> IF STK-DPT = "SBA0 "
> MOVE "N" TO OK.
> IF TOG = 4
> IF PCL-DPT = "X VAT "
> MOVE "N" TO OK.
> IF OK NOT = "Y"
> IF OK NOT = "N"
> GO TO SC-VAT.
> DISPLAY OK AT WS-POS.
> PERFORM FFD.
> PERFORM VRUB.
> IF OK = "N"
> MOVE ZERO TO WRK2 LVAT
> GO TO SC-EXT.
> MOVE ZERO TO WRK2.
> MULTIPLY VATPP BY WRK3 GIVING WRK2 ROUNDED.
> DIVIDE WRK2 BY 100 GIVING WRK2 ROUNDED LVAT ROUNDED.
> SC-EXT.
> IF STK-DPT = "X VAT "
> MOVE WRK3 TO WRK2 LVAT
> MOVE ZERO TO WRK3.
> DISPLAY LVAT AT 1052.
> ADD WRK2 TO WRK3.
> MOVE WRK3 TO Z6VZZ LVAL.
> PERFORM FFD.
> DISPLAY LVAL AT 1064.
> SC-OK.
> MOVE 77 TO WS-HPOS.
> PERFORM HD.
> MOVE "Y" TO OK.
> DISPLAY OK AT WS-POS.
> PERFORM VW1 THRU VW-X.
> PERFORM FFD.
> ACCEPT OK AT WS-POS.
> PERFORM VRUB.
> IF OK NOT = "Y"
> IF OK NOT = SPACE
> GO TO SC-ACT.
> DISPLAY OK AT WS-POS.
> IF ACT NOT = "D"
> IF WRK0 > STK-CQTY
> MOVE 1 TO IND2.
> IF ACT NOT = "D"
> SUBTRACT WRK0 FROM STK-CQTY GIVING WRK1
> ADD STK-ON-ORD TO WRK1
> IF WRK1 NOT > STK-REORD
> MOVE 1 TO IND3.
> IF ACT = "C"
> MOVE LNO TO LLNO WS-SUB LLN
> PERFORM COMOVE
> PERFORM NXTP
> PERFORM HD
> DISPLAY LIN AT PPOS
> ADD 1 TO POSV LNO
> GO TO SC-BAL.
> IF ACT = "D"
> PERFORM REMOV THRU RMX
> PERFORM SC-BAL
> PERFORM VIEW THRU VWX
> GO TO SC-ACT.
> PERFORM HD.
> DISPLAY " Replace Line NO " AT 1151.
> SC-NO.
> MOVE 1174 TO WS-POS.
> PERFORM VW2 THRU VW-X.
> MOVE ZERO TO ZZ.
> ACCEPT ZZ AT 1174.
> MOVE ZZ TO WNO.
> IF WNO < 1
> GO TO SC-ACT.
> IF WNO > 15
> GO TO SC-NO.
> MOVE GROSS(WNO) TO WRK.
> SUBTRACT WRK FROM BGROSS.
> MOVE PLDIS(WNO) TO WRK.
> SUBTRACT WRK FROM WQTY.
> MOVE PLVAT(WNO) TO WRK
> SUBTRACT WRK FROM WOTH.
> MOVE PLVAL(WNO) TO WRK.
> SUBTRACT WRK FROM WVAL.
> ADD WRK TO WBAL.
> MOVE WNO TO PLNO(WNO) WS-SUB.
> PERFORM COMOVE.
> DISPLAY " " AT 1151.
> DISPLAY "DONE" AT 1172.
> ACCEPT OK AT 1178.
> SC-BAL.
> ADD WGROSS TO BGROSS.
> ADD WRK0 TO BQTY.
> PERFORM FFD.
> MOVE LDIS TO WRK.
> ADD WRK WQTY GIVING WQTY Z6VZZ PLDIS(16).
> MOVE LVAL TO WRK
> ADD WRK WVAL GIVING WVAL Z7VZZ PLVAL(16) BVAL.
> DISPLAY Z7VZZ AT 0664.
> IF CASH = "A"
> SUBTRACT WRK FROM WBAL
> MOVE WBAL TO Z7VZZN
> DISPLAY Z7VZZN AT 0651.
> MOVE LVAT TO WRK.
> ADD WRK WOTH GIVING WOTH BOTH Z6VZZ PLVAT(16).
> SC-DUM.
> IF ACT = "A"
> PERFORM VIEW THRU VWX.
> GO TO SC-ACT.
> COMOVE.
> MOVE STK-DESC TO PDS(WS-SUB).
> MOVE STK-UNIT TO PUN(WS-SUB).
> MOVE WS-DPT TO VATPCL(WS-SUB).
> MOVE LIN TO PLIN(WS-SUB).
> MOVE TOG TO WT(WS-SUB).
> MOVE IND1 TO PIN1(WS-SUB).
> MOVE IND2 TO PIN2(WS-SUB).
> MOVE IND3 TO PIN3(WS-SUB).
> MOVE IND5 TO PIN5(WS-SUB).
> MOVE WGROSS TO GROSS(WS-SUB).
> MOVE ZZVZZ TO WRK
> MOVE WRK TO DPP(WS-SUB).
> MOVE LCST TO PLCST(WS-SUB).
> MOVE LSP TO WRK.
> MOVE WRK TO PLSP(WS-SUB).
> MOVE LSP5 TO PLSP5(WS-SUB).
> MOVE CVAL TO WC(WS-SUB).
> NXTP.
> IF POSV = 22
> MOVE 12 TO POSV.
> REMOV.
> MOVE GROSS(WNO) TO WGROSS.
> MOVE PLQTY(WNO) TO WRK0.
> MOVE PLVAL(WNO) TO WRK1.
> MOVE PLDIS(WNO) TO WRK2.
> MOVE PLVAT(WNO) TO WRK3.
> MULTIPLY -1 BY WRK0 WRK1 WRK2 WRK3 WGROSS.
> MOVE WRK1 TO LVAL.
> MOVE WRK2 TO LDIS.
> MOVE WRK3 TO LVAT.
> MOVE SPACE TO PLIN(WNO) PUN(WNO) PDS(WNO).
> ADD 1 WNO GIVING SUB.
> R1.
> MOVE PLIN(SUB) TO PLIN(WNO).
> MOVE GROSS(SUB) TO WRK.
> MOVE WRK TO GROSS(WNO).
> MOVE DPP(SUB) TO WRK.
> MOVE WRK TO DPP(WNO).
> MOVE WT(SUB) TO WT(WNO).
> MOVE WC(SUB) TO WC(WNO).
> MOVE PUN(SUB) TO PUN(WNO).
> MOVE PDS(SUB) TO PDS(WNO).
> MOVE VATPCL(SUB) TO VATPCL(WNO).
> MOVE PIN1(SUB) TO PIN1(WNO).
> MOVE PIN2(SUB) TO PIN2(WNO).
> MOVE PIN3(SUB) TO PIN3(WNO).
> MOVE PIN5(SUB) TO PIN5(WNO).
> MOVE PLCST(SUB) TO PLCST(WNO).
> MOVE PLSP5(SUB) TO PLSP5(WNO).
> IF PLSTK(WNO) NOT = SPACE
> ADD 1 TO WNO SUB
> GO TO R1.
> RMX.
> EXIT.
> VIEW.
> PERFORM FFD.
> MOVE ZERO TO LNO.
> MOVE 1 TO WNO.
> MOVE 12 TO POSV SUB.
> MOVE 3 TO POSH.
> V1.
> MOVE PLIN(WNO) TO LIN.
> IF LSTK NOT = SPACE
> MOVE POSV TO SUB
> MOVE WNO TO LNO PLNO(WNO) LLNO LLN.
> DISPLAY LIN AT PPOS.
> ADD 1 TO WNO POSV.
> IF PLSTK(WNO) NOT = SPACE
> IF WNO = 11
> DISPLAY "HIT ENTER TO CONTINUE" AT 2240
> ACCEPT OK AT 2270
> DISPLAY CLR AT 2202
> PERFORM HD
> MOVE 12 TO POSV
> GO TO V1
> ELSE
> GO TO V1
> ELSE
> IF WNO < 11
> GO TO V1.
> ADD 1 SUB GIVING POSV.
> ADD 1 TO LNO.
> IF LNO = 1
> MOVE 12 TO POSV.
> VWX.
> EXIT.
> SC-BCHEND.
> IF LNO = 1 GO TO SC-START.
> PERFORM FFD.
> DISPLAY CLR AT 1002.
> PERFORM HD.
> DISPLAY "Post Document ? (Y/N) [ ]" AT 1020.
> PERFORM FFD.
> MOVE SPACE TO OK NK.
> IF CASH = "C"
> MOVE ZERO TO IND4
> GO TO SC-BCHCSH.
> IF CASH = "A"
> IF WBAL < ZERO
> PERFORM CRLB
> MOVE 1 TO IND4
> MOVE "N" TO OK
> ELSE
> MOVE ZERO TO IND4
> GO TO SC-BCHCSH.
> DISPLAY OK AT 1044.
> IF WLOR NOT = "N"
> ACCEPT OK AT 1044
> ELSE
> ACCEPT NK AT 1044.
> IF OK = "N"
> GO TO M-SCREEN.
> IF NK = "N"
> GO TO M-SCREEN.
> GO TO SC-BCHON.
> SC-BCHCSH.
> PERFORM FFD.
> MOVE "Y" TO OK.
> DISPLAY OK AT 1044.
> ACCEPT OK AT 1044.
> IF CASH = "A"
> IF OK = "N"
> GO TO M-SCREEN
> ELSE
> GO TO SC-BCPAY.
> IF CASH = "C"
> IF OK = "Y"
> GO TO SC-BCPAY.
> DISPLAY CLR AT 2202.
> MOVE SPACE TO PASS.
> DISPLAY "Enter Password :" AT 2220.
> IF TRM < 2
> CALL X"AF" USING HV1, HV2.
> IF TRM = 2
> DISPLAY BFLDI AT 2239.
> IF TRM > 2
> DISPLAY BFLDO AT 2239.
> ACCEPT PASS AT 2240.
> IF TRM > 1
> DISPLAY NRMO AT 2239.
> IF PASS NOT = SPACE
> IF PASS = PPWD
> GO TO M-SCREEN.
> DISPLAY CLR AT 2202.
> GO TO SC-BCHCSH.
> SC-BCPAY.
> MOVE ZERO TO RTOTAL WRKS.
> IF CASH NOT = "C"
> GO TO SC-BCHON.
>
> MOVE PLVAL (16) TO RTOTAL.
> IF RCENT2 = 0
> MOVE ZERO TO RTOTAL
> GO TO SC-BCPAY1.
> IF RCENT2 = 5
> MOVE ZERO TO RTOTAL
> GO TO SC-BCPAY1.
>
> IF RCENT2 > 5
> SUBTRACT 5 FROM RCENT2.
> MOVE ZERO TO RRANDS RCENT1.
> MOVE RTOTAL TO WRKS.
> MOVE PLDIS (LLN) TO WRK.
> MOVE ZERO TO PLDIS (LLN).
> ADD WRK WRKS GIVING PLDIS (LLN).
> MOVE PLDIS (16) TO WRK.
> MOVE ZERO TO PLDIS (16).
> ADD WRK WRKS GIVING PLDIS (16).
> MOVE PLVAL (LLN) TO WRK.
> MOVE ZERO TO PLVAL (LLN).
> SUBTRACT WRKS FROM WRK GIVING PLVAL (LLN).
> MOVE PLVAL (16) TO WRK.
> MOVE ZERO TO PLVAL (16).
> SUBTRACT WRKS FROM WRK GIVING PLVAL (16) Z7VZZ.
> SUBTRACT WRKS FROM BVAL.
> DISPLAY Z7VZZ AT 0664.
> MOVE ZERO TO RTOTAL.
>
> SC-BCPAY1.
> DISPLAY CLR AT 2202.
> DISPLAY "CASH OR CHEQUE ? (C/T) [ ]" AT 2220.
> MOVE SPACE TO PAYM CIND TIND.
> ACCEPT PAYM AT 2244.
> DISPLAY CLR AT 2202.
> IF PAYM NOT = "C"
> IF PAYM NOT = "T"
> GO TO SC-BCPAY.
> IF PAYM = "C"
> MOVE " CASH " TO CIND
> ELSE
> MOVE "CHEQUE" TO TIND.
> SC-BCHON.
> DISPLAY CLR AT 1002.
> MOVE 1002 TO WS-POS.
> PERFORM SC-CLR.
> MOVE BGROSS TO GROSS(16).
> SC-RD1.
> PERFORM CTLRL.
> ADD 1 TO C00-INVNO(1).
> MOVE C00-INVNO(1) TO TRX-REF Z6.
> DISPLAY Z6 AT 0627.
> ADD 1 WSU GIVING WS-SUB.
> IF CASH = "C"
> ADD BVAL TO C00-CASHIN(WS-SUB).
> SC-RW1.
> PERFORM CTLR1 THRU FL9.
> COMMIT.
> GO TO SC-X.
> VW15.
> MOVE 14 TO VLNG.
> GO TO VW1.
> VW11.
> ADD 1 TO VLNG.
> VW10.
> ADD 1 TO VLNG.
> VW9.
> ADD 1 TO VLNG.
> VW8.
> ADD 1 TO VLNG.
> VW7.
> ADD 1 TO VLNG.
> VW6.
> ADD 1 TO VLNG.
> VW5.
> ADD 1 TO VLNG.
> VW4.
> ADD 1 TO VLNG.
> VW3.
> ADD 1 TO VLNG.
> VW2.
> ADD 1 TO VLNG.
> VW1.
> ADD 1 TO VLNG.
> SUBTRACT 1 FROM WS-HPOS GIVING VS-HP1 VS-HP2.
> MOVE WS-VPOS TO VS-VP1 VS-VP2.
> ADD VLNG TO VS-HP2.
> ADD 1 TO VS-HP2.
> DISPLAY "[" AT VS-P1.
> DISPLAY "]" AT VS-P2.
> MOVE 0 TO VLNG.
> VW-X.
> EXIT.
> VRUB.
> DISPLAY " " AT VS-P1.
> DISPLAY " " AT VS-P2.
> SC-X.
> EXIT.
> PROC1 SECTION.
> MOVE 0 TO DIND.
> MOVE 1 TO SUB.
> DCHK.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO DXIT.
> IF PLSTK (SUB) NOT = "02000020"
> IF PLSTK (SUB) NOT = "02000044"
> IF PLSTK (SUB) NOT = "SBA0 "
> ADD 1 TO SUB
> GO TO DCHK.
> MOVE 1 TO SUB DIND.
> DXIT.
> MOVE ZERO TO VATTOT(1) VATTOT(2) VATTOT(3) VATTOT(4)
> VATTOT(5) VATTOT(6) VATTOT(7) VATTOT(8)
> VATTOT(9) VATTOT(10) VATTOT(11) VATTOT(12)
> VATTOT(13) VATTOT(14) VATTOT(15) TOTVAT.
> * IF W01-VATNO = SPACES
> GO TO VATEXIT.
> VAT1.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT2.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT2.
> IF VATGRP (SUB) = "A"
> GO TO VAT1B.
> ADD 1 TO SUB.
> GO TO VAT1.
> VAT1B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (1).
> ADD 1 TO SUB.
> GO TO VAT1.
> VAT2.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT3.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT3.
> IF VATGRP (SUB) = "C"
> GO TO VAT2B.
> ADD 1 TO SUB.
> GO TO VAT2.
> VAT2B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (2).
> ADD 1 TO SUB.
> GO TO VAT2.
> VAT3.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT4.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT4.
> IF VATGRP (SUB) = "F"
> GO TO VAT3B.
> ADD 1 TO SUB.
> GO TO VAT3.
> VAT3B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (3).
> ADD 1 TO SUB.
> GO TO VAT3.
> VAT4.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT5.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT5.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "A0"
> GO TO VAT4B.
> ADD 1 TO SUB.
> GO TO VAT4.
> VAT4B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (4).
> ADD 1 TO SUB.
> GO TO VAT4.
> VAT5.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT6.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT6.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "B0"
> GO TO VAT5B.
> ADD 1 TO SUB.
> GO TO VAT5.
> VAT5B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (5).
> ADD 1 TO SUB.
> GO TO VAT5.
> VAT6.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT7.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT7.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "C0"
> GO TO VAT6B.
> ADD 1 TO SUB.
> GO TO VAT6.
> VAT6B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (6).
> ADD 1 TO SUB.
> GO TO VAT6.
> VAT7.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT8.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT8.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "D0"
> GO TO VAT7B.
> ADD 1 TO SUB.
> GO TO VAT7.
> VAT7B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (7).
> ADD 1 TO SUB.
> GO TO VAT7.
> VAT8.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT9.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT9.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "E0"
> GO TO VAT8B.
> ADD 1 TO SUB.
> GO TO VAT8.
> VAT8B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (8).
> ADD 1 TO SUB.
> GO TO VAT8.
> VAT9.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT10.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT10.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "J0"
> GO TO VAT9B.
> ADD 1 TO SUB.
> GO TO VAT9.
> VAT9B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (9).
> ADD 1 TO SUB.
> GO TO VAT9.
> VAT10.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VAT11.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VAT11.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "K0"
> GO TO VAT10B.
> ADD 1 TO SUB.
> GO TO VAT10.
> VAT10B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (10).
> ADD 1 TO SUB.
> GO TO VAT10.
> VAT11.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATEXIT.
> IF PLSTK (SUB) = SPACE
> MOVE 1 TO SUB
> GO TO VATEXIT.
> IF VATGRP (SUB) = "D"
> GO TO VAT11B.
> ADD 1 TO SUB.
> GO TO VAT11.
> VAT11B.
> MOVE PLVAT (SUB) TO VWRK1.
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK1 FROM VWRK2.
> ADD VWRK2 TO VATTOT (11).
> ADD 1 TO SUB.
> GO TO VAT11.
> VATEXIT.
> EXIT.
> PROC2 SECTION.
> VATC1.
> * IF W01-VATNO = SPACES
> GO TO VATE1.
> IF VATTOT (1) < ZERO
> GO TO VATC2.
> MOVE 1 TO SUB.
> VATA1.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC2.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC2.
> IF VATGRP (SUB) = "A"
> GO TO VATB1.
> ADD 1 TO SUB.
> GO TO VATA1.
> VATB1.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA1.
> VATC2.
> IF VATTOT (2) < ZERO
> GO TO VATC3.
> MOVE 1 TO SUB.
> VATA2.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC3.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC3.
> IF VATGRP (SUB) = "C"
> GO TO VATB2.
> ADD 1 TO SUB.
> GO TO VATA2.
> VATB2.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA2.
> VATC3.
> IF VATTOT (3) < ZERO
> GO TO VATC4.
> MOVE 1 TO SUB.
> VATA3.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC4.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC4.
> IF VATGRP (SUB) = "F"
> GO TO VATB3.
> ADD 1 TO SUB.
> GO TO VATA3.
> VATB3.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA3.
> VATC4.
> IF VATTOT (4) < ZERO
> GO TO VATC5.
> MOVE 1 TO SUB.
> VATA4.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC5.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC5.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "A0"
> GO TO VATB4.
> ADD 1 TO SUB.
> GO TO VATA4.
> VATB4.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA4.
> VATC5.
> IF VATTOT (5) < ZERO
> GO TO VATC6.
> MOVE 1 TO SUB.
> VATA5.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC6.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC6.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "B0"
> GO TO VATB5.
> ADD 1 TO SUB.
> GO TO VATA5.
> VATB5.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA5.
> VATC6.
> IF VATTOT (6) < ZERO
> GO TO VATC7.
> MOVE 1 TO SUB.
> VATA6.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC7.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC7.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "C0"
> GO TO VATB6.
> ADD 1 TO SUB.
> GO TO VATA6.
> VATB6.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA6.
> VATC7.
> IF VATTOT (7) < ZERO
> GO TO VATC8.
> MOVE 1 TO SUB.
> VATA7.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC8.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC8.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "D0"
> GO TO VATB7.
> ADD 1 TO SUB.
> GO TO VATA7.
> VATB7.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA7.
> VATC8.
> IF VATTOT (8) < ZERO
> GO TO VATC9.
> MOVE 1 TO SUB.
> VATA8.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC9.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC9.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "E0"
> GO TO VATB8.
> ADD 1 TO SUB.
> GO TO VATA8.
> VATB8.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA8.
> VATC9.
> IF VATTOT (9) < ZERO
> GO TO VATC10.
> MOVE 1 TO SUB.
> VATA9.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC10.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC10.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "J0"
> GO TO VATB9.
> ADD 1 TO SUB.
> GO TO VATA9.
> VATB9.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA9.
> VATC10.
> IF VATTOT (10) < ZERO
> GO TO VATC11.
> MOVE 1 TO SUB.
> VATA10.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATC11.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATC11.
> IF VATGRP (SUB) = "H"
> IF VATCLS (SUB) = "K0"
> GO TO VATB10.
> ADD 1 TO SUB.
> GO TO VATA10.
> VATB10.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA10.
> VATC11.
> IF VATTOT (11) < ZERO
> GO TO VATE1.
> MOVE 1 TO SUB.
> VATA11.
> IF SUB > 15
> MOVE 1 TO SUB
> GO TO VATE1.
> IF PLSTK (SUB) = SPACES
> MOVE 1 TO SUB
> GO TO VATE1.
> IF VATGRP (SUB) = "D"
> GO TO VATB11.
> ADD 1 TO SUB.
> GO TO VATA11.
> VATB11.
> MOVE PLVAT (SUB) TO VWRK1.
> ADD VWRK1 TO TOTVAT.
> SUBTRACT VWRK1 FROM WOTH BOTH.
> MOVE BOTH TO PLVAT(16).
> MOVE ZERO TO PLVAT (SUB).
> MOVE PLVAL (SUB) TO VWRK2.
> SUBTRACT VWRK2 FROM WVAL BVAL.
> SUBTRACT VWRK1 FROM VWRK2.
> MOVE VWRK2 TO PLVAL (SUB).
> ADD VWRK2 TO WVAL BVAL.
> MOVE BVAL TO PLVAL(16).
> ADD 1 TO SUB.
> GO TO VATA11.
> VATE1.
> IF CASH NOT = "C"
> GO TO VATE1B.
> PERFORM CTLRL.
> ADD 1 WSU GIVING WS-SUB.
> SUBTRACT TOTVAT FROM C00-CASHIN(WS-SUB).
> VATE1A.
> PERFORM CTLR1 THRU FL9.
> COMMIT.
> VATE1B.
> IF W01-MTYPE NOT = "Z"
> GO TO VATEND.
> MOVE SPACES TO W02-NAME W02-ADR1 W02-ADR2 W02-ADR3 W02-PCOD.
> DISPLAY "NAME.... [ ]" AT 1120.
> IF BGROSS < 200
> GO TO VATE1C.
> DISPLAY "ADDRESS. [ ]" AT 1220.
> DISPLAY " [ ]" AT 1320.
> DISPLAY " [ ]" AT 1420.
> DISPLAY "PCOD.... [ ]" AT 1520.
> VATE1C.
> ACCEPT W02-NAME AT 1131.
> IF BGROSS < 200
> GO TO VATE1D.
> ACCEPT W02-ADR1 AT 1231.
> ACCEPT W02-ADR2 AT 1331.
> ACCEPT W02-ADR3 AT 1431.
> ACCEPT W02-PCOD AT 1531.
> VATE1D.
> IF BGROSS < 20
> IF W02-NAME = SPACES
> GO TO VATEND
> ELSE
> GO TO VATE3.
> IF BGROSS NOT < 20
> IF BGROSS < 200
> IF W02-NAME NOT = SPACES
> GO TO VATE3.
> IF BGROSS NOT < 200
> IF W02-ADR1 NOT = SPACES
> GO TO VATE3.
> GO TO VATE1B.
> VATE3.
> MOVE W02-NAME TO W01-NAME.
> MOVE W02-ADR1 TO W01-ADR1.
> MOVE W02-ADR2 TO W01-ADR2.
> MOVE W02-ADR3 TO W01-ADR3.
> MOVE W02-PCOD TO W01-PCOD.
> VATEND.
> DISPLAY CLRM AT 1120.
> DISPLAY CLRM AT 1140.
> DISPLAY CLRM AT 1220.
> DISPLAY CLRM AT 1240.
> DISPLAY CLRM AT 1320.
> DISPLAY CLRM AT 1340.
> DISPLAY CLRM AT 1420.
> DISPLAY CLRM AT 1440.
> DISPLAY CLRM AT 1520.
> DISPLAY CLRM AT 1540.
> DISPLAY " Printing in progress..." AT 1020.
> EXIT.
> PROC3 SECTION.
> MOVE ZERO TO DONE.
> P3-START.
> PERFORM P3-BUF.
> OPEN OUTPUT PRINT-FILE.
> MOVE SPACES TO PLINE.
> MOVE OFFCON TO PLINE.
> WRITE PLINE AFTER 0.
> MOVE LOW-VALUES TO PLINE.
> MOVE 1 TO SUB.
> MOVE SPACES TO PL11.
> MOVE DEB-NAME TO PAD.
> WRITE PLINE AFTER TOF.
> MOVE DEB-ADR1 TO PAD.
> WRITE PLINE.
> MOVE DEB-ADR2 TO PAD.
> WRITE PLINE.
> MOVE LOW-VALUES TO PLINE.
> MOVE SPACES TO PL11.
> MOVE DEB-PCOD TO PCOD.
> MOVE DEB-ADR3 TO PTOWN.
> WRITE PLINE.
> MOVE SPACES TO PLINE.
> WRITE PLINE.
> MOVE LOW-VALUES TO PLINE.
> MOVE SPACES TO PL21 PL21A PTIT PDREG.
> IF DIND = 1
> IF DEB-DREG NOT = SPACES
> MOVE "DIESEL REG. NO.-" TO PTIT
> MOVE W01-DREG TO PDREG.
> MOVE CUSSUF TO PCUS.
> MOVE ACDTE TO PDTE.
> IF CASH = "C"
> IF PAYM = "C"
> MOVE CIND TO PCHQ.
> IF CASH = "C"
> IF PAYM = "T"
> MOVE TIND TO PCHQ.
> WRITE PLINE.
> MOVE LOW-VALUES TO PLINE.
> MOVE SPACE TO PL31.
> MOVE BRN TO PBRN.
> IF CASH = "C"
> MOVE "CASH" TO PTRM
> ELSE
> MOVE "ACCOUNT" TO PTRM.
> IF RP = "Y"
> MOVE "REPRINT" TO PTYPE
> ELSE
> MOVE "INV/FAK" TO PTYPE.
> MOVE TRX-REF TO PGRN.
> MOVE "MEMBER" TO PMDES.
> IF DEB-MTYPE = "N"
> MOVE "NON-MEMBER" TO PMDES.
> IF DEB-MTYPE = "X"
> MOVE "NON-MEMBER" TO PMDES.
> IF DEB-MTYPE = "Z"
> MOVE "NON-MEMBER" TO PMDES.
> IF DEB-MTYPE = "S"
> MOVE "NON-MEMBER" TO PMDES.
> MOVE DEB-VATNO TO PVATNO.
> WRITE PLINE AFTER 3.
> MOVE LOW-VALUES TO PLINE.
> WRITE PLINE AFTER 2.
> MOVE ZERO TO LNECNT.
> MOVE SPACES TO PLINE.
> MOVE CON TO PLINE.
> WRITE PLINE AFTER 0.
> MOVE SPACE TO PLINE.
> P3-LOOP.
> IF SUB > 15
> GO TO P3-TOT.
> IF PLSTK(SUB) = SPACE
> GO TO P3-TOT.
> MOVE SPACE TO PLINE.
> MOVE PLSTK(SUB) TO PLS.
> MOVE PDS(SUB) TO PD.
> MOVE PUN(SUB) TO PU.
> P3-COMMON.
> MOVE PLQTY(SUB) TO PQ.
> MOVE PLSP(SUB) TO PPRC.
> MOVE GROSS(SUB) TO PG.
> MOVE DPP(SUB) TO PDPP.
> MOVE PLDIS(SUB) TO PDIS.
> MOVE PLVAT(SUB) TO PVAT.
> MOVE PLVAL(SUB) TO PVAL.
> WRITE PLINE.
> ADD 1 TO LNECNT SUB.
> GO TO P3-LOOP.
> P3-TOT.
> MOVE SPACE TO PLINE.
> SUBTRACT LNECNT FROM 19 GIVING LNECNT.
> GO TO P31 P32 P33 P34 P35 P36 P37 P38 P39 P310 P311 P312
> P313 P314 P315 P316 P317 P318 DEPENDING ON LNECNT.
> P31.
> WRITE PLINE AFTER 1.
> GO TO P399.
> P32.
> WRITE PLINE AFTER 2.
> GO TO P399.
> P33.
> WRITE PLINE AFTER 3.
> GO TO P399.
> P34.
> WRITE PLINE AFTER 4.
> GO TO P399.
> P35.
> WRITE PLINE AFTER 5.
> GO TO P399.
> P36.
> WRITE PLINE AFTER 6.
> GO TO P399.
> P37.
> WRITE PLINE AFTER 7.
> GO TO P399.
> P38.
> WRITE PLINE AFTER 8.
> GO TO P399.
> P39.
> WRITE PLINE AFTER 9.
> GO TO P399.
> P310.
> WRITE PLINE AFTER 10.
> GO TO P399.
> P311.
> WRITE PLINE AFTER 11 .
> GO TO P399.
> P312.
> WRITE PLINE AFTER 12.
> GO TO P399.
> P313.
> WRITE PLINE AFTER 13.
> GO TO P399.
> P314.
> WRITE PLINE AFTER 14.
> GO TO P399.
> P315.
> WRITE PLINE AFTER 15.
> GO TO P399.
> P316.
> WRITE PLINE AFTER 16.
> GO TO P399.
> P317.
> WRITE PLINE AFTER 17.
> GO TO P399.
> P318.
> WRITE PLINE AFTER 18.
> P399.
> MOVE GROSS(16) TO PG.
> MOVE PLDIS(16) TO PDIS.
> MOVE PLVAT(16) TO PVAT.
> MOVE PLVAL(16) TO PVAL.
> MOVE PLVAL(16) TO VAL.
> WRITE PLINE.
> MOVE SPACES TO PLINE.
> WRITE PLINE.
> MOVE LOW-VALUES TO PLINE.
> WRITE PLINE AFTER BOF.
> CLOSE PRINT-FILE.
> P3-TILL.
> IF CASH NOT = "C"
> GO TO P3-XT.
> IF RP = "Y"
> GO TO P3-XT.
> PERFORM SC-CL1.
> DISPLAY "Amount Due - R" AT 2403.
> MOVE VAL TO DPRC.
> DISPLAY DPRC AT 2418.
> IF TRM = 1
> DISPLAY TSTRT
> MOVE DPRC TO ZAMT
> MOVE TAMT TO TVAL
> MOVE X"73" TO TCHR
> DISPLAY TACT
> DISPLAY TSTOP.
> DISPLAY "Paid" AT 2429.
> DISPLAY BRKT AT 2434.
> DISPLAY DPRC AT 2435.
> MOVE SPACES TO AFLD.
> ACCEPT AFLD AT 2435.
> IF AFLD = SPACES
> MOVE DPRC TO PAID
> ELSE
> MOVE NFLD TO PAID.
> MOVE PAID TO DPRC.
> IF TRM = 1
> DISPLAY TSTRT
> MOVE DPRC TO ZAMT
> MOVE TAMT TO TVAL
> MOVE X"65" TO TCHR
> DISPLAY TACT
> DISPLAY TSTOP.
> IF PAID = VAL
> GO TO P3-TILLA.
> IF PAID > VAL
> GO TO P3-TILLA.
> PERFORM SC-CL1.
> GO TO P3-TILL.
> P3-TILLA.
> DISPLAY DPRC AT 2435.
> SUBTRACT VAL FROM PAID GIVING CHNG.
> DISPLAY "Change" AT 2447.
> DISPLAY BRKT AT 2454.
> MOVE CHNG TO DPRC.
> DISPLAY DPRC AT 2455.
> IF TRM = 1
> DISPLAY TSTRT
> MOVE DPRC TO ZAMT
> MOVE TAMT TO TVAL
> MOVE X"79" TO TCHR
> DISPLAY TACT
> DISPLAY TSTOP
> DISPLAY TOPEN.
> IF CHNG = ZERO
> GO TO P3-XT.
> DISPLAY OKM AT 2467.
> MOVE SPACE TO OK.
> ACCEPT OK AT 2479.
> IF OK NOT = "Y"
> GO TO P3-TILL.
> GO TO P3-XT.
> P3-BUF.
> MOVE CUS TO DEB-ACNO.
> MOVE SUF TO DEB-ACSUF.
> MOVE 100 TO DEB-RTYP.
> MOVE WS-CO TO DEB-CO.
> MOVE W01-NAME TO DEB-NAME.
> MOVE W01-ADR1 TO DEB-ADR1.
> MOVE W01-ADR2 TO DEB-ADR2.
> MOVE W01-ADR3 TO DEB-ADR3.
> MOVE W01-PCOD TO DEB-PCOD.
> MOVE W01-DREG TO DEB-DREG.
> MOVE W01-MTYPE TO DEB-MTYPE.
> MOVE W01-VATNO TO DEB-VATNO.
> P3-XT.
> EXIT.
> PROC4 SECTION.
> DISPLAY "Please wait - Posting in progress..." AT 1020.
> MOVE ZERO TO WS-FSTSW CVAL DISC WRK1.
> MOVE 12 TO POSV.
> MOVE 1 TO SUB DONE.
> P1-1.
> COMMIT.
> IF SUB > 15
> GO TO P1-X.
> IF PLSTK(SUB) = SPACE
> GO TO P1-X.
> MOVE CUS TO TRX-SCUS.
> MOVE SUF TO TRX-SSUF.
> MOVE PLSTK(SUB) TO TRX-STK STK-STKNO WS-DPT.
> MOVE WS-CO TO STK-CO PCL-CO.
> MOVE 100 TO STK-TYP PCL-TYP.
> IF WT(SUB) = 4
> PERFORM P1-PCLR
> MOVE PCL-DESC TO TRX-NAM
> MOVE WS-DPT TO TRX-SDPT
> MOVE SPACES TO TRX-SUP
> GO TO P1-CONT.
> MOVE STK-KEY TO WS-KEY.
> P1-RD1.
> MOVE WS-KEY TO STK-KEY.
> MOVE 2 TO CHK.
> PERFORM STK1 THRU FL9.
> MOVE STK-DESC TO TRX-NAM.
> MOVE STK-DPT TO WS-DPT TRX-SDPT.
> MOVE STK-SUP1 TO TRX-SUP.
> PERFORM P1-PCLR.
> P1-CONT.
> MOVE PIN1(SUB) TO TRX-IND(1).
> IF TRX-IND(1) NOT = ZERO
> MOVE STK-SP1 TO TRX-AMT(9).
> MOVE PIN2(SUB) TO TRX-IND(2).
> MOVE PIN3(SUB) TO TRX-IND(3).
> MOVE PIN5(SUB) TO TRX-PIND.
> MOVE PLQTY(SUB) TO TRX-AMT(1).
> MOVE PLVAT(SUB) TO TRX-AMT(3).
> MOVE PLVAL(SUB) TO TRX-AMT(8).
> MOVE PLDIS(SUB) TO TRX-AMT(7).
> SUBTRACT TRX-AMT(3) FROM TRX-AMT(8).
> MOVE PLSP5(SUB) TO TRX-AMT(5).
> IF WT(SUB) NOT = 4
> MOVE STK-CPPRC(1) TO TRX-AMT(2)
> ELSE
> MOVE PLCST(SUB) TO TRX-AMT(2).
> MULTIPLY TRX-AMT(1) BY TRX-AMT(2) GIVING WC(SUB) ROUNDED
> TRX-AMT(4) ROUNDED.
> IF STK-STYP = "S"
> DIVIDE 100 INTO TRX-AMT(4) ROUNDED WC(SUB) ROUNDED.
> MULTIPLY MUL BY TRX-AMT(1) TRX-AMT(3) TRX-AMT(4) TRX-AMT(8)
> WC(SUB).
> ADD WC(SUB) TO CVAL.
> MOVE PLDIS(SUB) TO WRK.
> ADD WRK TO DISC PCL-MDISC PCL-YDISC.
> ADD TRX-AMT(8) TO PCL-MSLS PCL-YSLS.
> ADD TRX-AMT(4) TO PCL-MCST PCL-YCST.
> IF WT(SUB) = 4
> MOVE ZERO TO TRX-AMT(6)
> GO TO P1-PCLW.
> ADD TRX-AMT(1) TO STK-SQTY STK-CQTY STK-LOC-QTY(1)
> STK-CPQTY(1) STK-YQTY ROUNDED
> STK-CUM-QTY ROUNDED.
> ADD TRX-AMT(8) TO STK-SSLS STK-YSLS ROUNDED
> STK-CUM-SLS ROUNDED.
> ADD TRX-AMT(4) TO STK-SCST STK-CCST STK-YCST ROUNDED
> STK-CUM-CST ROUNDED.
> MOVE SPACE TO STK-STP.
> MOVE ZERO TO STK-SPR.
> MOVE PLCST(SUB) TO WRK.
> IF MUL = 1
> IF WRK NOT = STK-CPPRC(1)
> MOVE STK-CPYR(1) TO STK-CPYR(2)
> MOVE STK-CPPRC(1) TO STK-CPPRC(2)
> MOVE ZERO TO STK-CPQTY(2)
> DIVIDE STK-CCST BY STK-CQTY GIVING STK-CPPRC(1) WRKV4
> MOVE WS-YR TO STK-CPYR(1)
> MOVE STK-CQTY TO STK-CPQTY(1)
> IF STK-STYP = "S"
> MULTIPLY 100 BY WRKV4
> MOVE WRKV4 TO STK-CPPRC(1).
> P1-SRW.
> PERFORM STKR1 THRU FL9.
> COMMIT.
> GO TO P1-PCLW.
> P1-PRW.
> PERFORM PCLR1 THRU FL9.
> COMMIT.
> P1-PCLR.
> MOVE WS-CO TO PCL-CO.
> MOVE WS-DPT TO PCL-DPT.
> MOVE 100 TO PCL-TYP.
> MOVE 2 TO CHK.
> PERFORM PCL1 THRU FL9.
> P1-PCLW.
> PERFORM PCLR1 THRU FL9.
> COMMIT.
> ADD TRX-AMT(3) TO WRK1.
> P1-COMMON.
> PERFORM SC-TRNOUT THRU SC-TRXT.
> MOVE PLIN(SUB) TO LIN.
> DISPLAY LIN AT PPOS.
> MOVE ZERO TO WT(SUB) WC(SUB).
> ADD 1 TO SUB POSV.
> IF POSV = 22
> MOVE 12 TO POSV
> PERFORM HD.
> GO TO P1-1.
> P1-X.
> IF WRK1 NOT = ZERO
> MOVE DVAT TO WS-DPT
> PERFORM P1-PCLR
> ADD WRK1 TO PCL-MSLS PCL-YSLS PCL-MCST PCL-YCST
> PERFORM P1-PRW.
> MULTIPLY MUL BY BVAL BOTH.
> MULTIPLY -1 BY BVAL CVAL BOTH.
> IF BVAL < ZERO
> MOVE 2 TO TRX-TYP
> ELSE
> MOVE 1 TO TRX-TYP.
> MOVE CUS TO TRX-STK.
> MOVE SUF TO TRX-ACSUF.
> P1-RD2.
> COMMIT.
> MOVE WS-CO TO DEB-CO.
> MOVE TRX-CUS TO DEB-ACNO.
> MOVE TRX-ACSUF TO DEB-ACSUF.
> MOVE 100 TO DEB-RTYP.
> MOVE DEB-KEY TO WS-CKEY.
> MOVE 1 TO CHK.
> PERFORM DEB1 THRU FL9.
> IF CHK = 1
> GO TO P1-XT.
> ADD CVAL TO DEB-CCOST.
> IF CASH NOT = "C"
> ADD BVAL TO DEB-CBAL DEB-CUR.
> IF BVAL < ZERO
> ADD BVAL TO DEB-CTRX
> ELSE
> ADD BVAL TO DEB-DTRX.
> IF CASH = "C"
> IF BVAL < ZERO
> SUBTRACT BVAL FROM DEB-DTRX
> ELSE
> SUBTRACT BVAL FROM DEB-CTRX.
> ADD BOTH TO DEB-VAT.
> SUBTRACT BOTH FROM BVAL GIVING WRK.
> ADD WRK TO DEB-CSLS.
> P1-RWD.
> PERFORM DEBR1 THRU FL9.
> COMMIT.
> MOVE DEB-NAME TO TRX-NAM.
> TS-JNL.
> MOVE "TD" TO TRX-RTYP.
> IF CASH = "C"
> ADD 10 TO TRX-TYP.
> MOVE IND4 TO TRX-IND(4).
> MOVE ZERO TO IND4.
> MOVE WS-CO TO TRX-CO.
> MULTIPLY -1 BY DISC GIVING TRX-AMT(9).
> MOVE BOTH TO TRX-AMT(3).
> MOVE BVAL TO TRX-AMT(8).
> MOVE CVAL TO TRX-AMT(4).
> TS-W.
> PERFORM TRXW1 THRU FL9.
> MOVE "TS" TO TRX-RTYP.
> MOVE 4 TO TRX-TYP.
> COMMIT.
> MOVE 1002 TO WS-POS.
> PERFORM SC-CLR.
> P1-XT.
> EXIT.
> A000-INIT SECTION.
> MOVE ZERO TO USW.
> DISPLAY SPACES.
> IF TRM > 1
> DISPLAY GRON.
> DISPLAY BORDER.
> DISPLAY ENT1-01.
> IF TRM > 1
> DISPLAY GROFF.
> PERFORM HD.
> DISPLAY ENT1-00.
> PERFORM FFD.
> A000-CO.
> IF WS-FSTSW NOT = 1
> DISPLAY BLANKDES AT 0912
> DISPLAY BLANKDES AT 0928
> GO TO A010-CO.
> MOVE ZEROES TO TRXREC.
> PERFORM GETEOD THRU GEX.
> IF OK = "E"
> GO TO A999-X.
> PERFORM R00-READ THRU R00-RX.
> IF OK = "E"
> GO TO A999-X.
> PERFORM HD.
> DISPLAY R00-CONAM AT 1012.
> MOVE R00-VATPP TO VATPP.
> MOVE R00-DVAT TO DVAT.
> MOVE R00-CONAM TO H10NAM.
> MOVE R00-BRNAM TO BRN.
> MOVE R00-SOR TO WSOR.
> MOVE R00-LOR TO WLOR.
> PERFORM A99-GETJNL.
> DISPLAY "JOURNAL WNO. " AT 1112.
> DISPLAY TRX-JNL AT 1126.
> PERFORM FFD.
> MOVE TRX-JNL TO WS-LASTJ WS-TJNL.
> GO TO A020-DATE.
> A010-CO.
> DISPLAY "END OF COMPANY ? (Y/N) " AT 0910.
> ACCEPT OK AT 0935.
> IF OK = "Y"
> MOVE 1 TO WS-FSTSW
> GO TO A000-CO.
> MOVE WS-LASTJ TO TRX-JNL.
> DISPLAY BLANKDES AT 0910.
> DISPLAY BLANKDES AT 0920.
> GO TO A020-DATE.
> A010-TYP.
> MOVE ZERO TO TRX-TYP OK S-TYP.
> MOVE ZERO TO LOK.
> DISPLAY OK AT 1533.
> IF LOK NOT = ZERO
> PERFORM RESTYP.
> MOVE 1 TO OK WS-SUB SUBA.
> MOVE OK TO TRX-TYP.
> IF TRX-TYP = SPACE
> GO TO A010-TYP.
> IF TRX-TYP < 1
> GO TO A010-TYP.
> IF TRX-TYP > 1
> GO TO A010-TYP.
> MOVE TRX-TYP TO WS-SUB SUBA.
> MOVE WS-TRXDES(WS-SUB) TO H10DES SDES.
> PERFORM SHOW-TYPE THRU SHX.
> DISPLAY OK AT 1533.
> A010-11.
> MOVE TRX-TYP TO H10TRX WS-TYP.
> MOVE T1(WS-TYP) TO LH2.
> MOVE T2(WS-TYP) TO LH3.
> MOVE -1 TO MUL.
> MOVE 4 TO S-TYP.
> GO TO A030-BCHCHK.
> A020-DATE.
> MOVE SDT TO WS-DATE ZDATE.
> DISPLAY ZDATE AT 1328.
> ACCEPT WS-DATE AT 1328.
> MOVE WS-DATE TO NDTE.
> PERFORM DTCHK.
> IF CHK = 1
> GO TO A020-DATE.
> MOVE WS-DATE TO ZDATE H10DAT TRX-DAT.
> DISPLAY ZDATE AT 1328.
> A030-BATCH.
> MOVE ZERO TO ZZZ.
> DISPLAY ZZZ AT 1432.
> ACCEPT ZZZ AT 1432.
> | |