Columns . . . : Edit GOLFP/SRCFILE
SEU==>_______________________________________________________ PGM02
FMT H HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*************** Beginning of data *************************************
H
F*-----------------------------------------------------------------------
F*- This is program PGM02, PROCESS CASH SALES © ---
F*- Author: Browning,02/02/98 ---
F*- ---
F*- PURPOSE: ---
F*- ---
F*- INDICATORS: 70-- SETLL SPRGLF ---
F*- 75-- CHAIN SPRSBC ---
F*- 80-- CHAIN SPRCRF ---
F*- 88-- CHAIN SPRINV ---
F*- 90-- CHAIN SUBF1 ---
F*- ---
F*- Associated Files: PGMP02 -- PRINTER FILE FOR PROGRAM 2 ---
F*- SPRCPT -- SUBFILE DSPF ---
F*- ---
F*ILENAME++IPEASFRlen+LKlen+AIDevice+.Keywords+++++++++++++++++++++++++--
FSPRHED IF E DISK
FSPRGLF UF E K DISK
FSPRINV UF E K DISK
FSPRCRF UF A E K DISK
FSPRSBC UF E K DISK
FSPRSBI UF E K DISK
FSPRCPT CF E WORKSTN SFILE(SUBF1:RRN)
F SFILE(SUBF2:RRN2)
FPGMP02 O E PRINTER
D*- DEFINE ARRAY SPEC'S ----------------------------------------------
D X S 1S 0
D ACCTNH S 4S 0 DIM(6) CTDATA PERRCD(1)
D ACCT S 4S 0
D*-DEFINE PROGRAM VARIABLES ------------------------------------------
D NUMBR S 1A
D TAC S 9S 2
D PFIT S 9S 2
D WARE S 9S 2
D SPORT S 9S 2
D RRN S 2S 0
D RRN2 S 2S 0
D MYDATE S D DATFMT(*USA)
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2+++++++RESULT++++++++LEN++D+HILOEQ
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2Extended-FACTOR2++++++++++++++++++
C SBCKEY KLIST
C KFLD CUSTNO
C KFLD MON
C SBIKEY KLIST
C KFLD ITMNO
C KFLD MON
C CRFKEY KLIST
C KFLD TDATE
C KFLD CODE
C READ SPRHED
C EVAL *IN03 = *OFF
C MOVE UDATE MYDATE
C WRITE TITLE
C DOW *IN03 = *OFF
C EVAL X = 0
C IF *IN72 = *OFF AND *IN73 = *OFF
C EXSR INIT
C ENDIF
C WRITE scrn1
c exfmt subctl1
C IF *IN03 = *ON
C LEAVE
C ENDIF
c eval *in72 = *off
c eval *in73 = *off
c exsr verify
c if *in72 = *on or *in73 = *on
c iter
c else
c exsr verify2
c endif
c write scrn2
c exfmt subctl2
c if *in12 = *on
c iter
c ENDIF
C EXSR ITEMUP
C EXSR SEPRTE
C EXSR UPCRF
C EXSR UPGLF
C EXSR UPSBC
C EXSR UPSBI
C WRITE DETAIL
C ENDDO
C EVAL *INLR = *ON
C WRITE TOTAL
C RETURN
C*----------- SUBROUTINES ---------------------------------------------**
C*----------- INITALIZE SCREENS ---------------------------------------
C INIT BEGSR
C EVAL *IN50 = *ON
C WRITE subctl1
c write subctl2
C EVAL *IN50 = *OFF
C EVAL rrn = *ZERO
c eval rrn2 = *zero
C ENDSR
C*---------------------------------------------------------------------
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2+++++++RESULT++++++++LEN++D+HILOEQ
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2Extended-FACTOR2++++++++++++++++++
c verify begsr
c eval rrn = *zero
c dou rrn >= 40
c eval rrn = rrn + 1
c rrn chain subf1 90
c if itno = *blanks
c leave
c endif
c itno chain sprinv
c if not%found(sprinv)
c eval *in72 = *on
c eval flag1 = '*'
c else
c eval flag1 = ' '
c endif
c if qty1 = *zero
c eval *in73 = *on
c eval flag2 = '*'
c else
c eval flag2 = ' '
c endif
c update subf1
c enddo
c endsr
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2Extended-FACTOR2++++++++++++++++++
c verify2 begsr
c eval subttl = *zero
c eval tax = *zero
c eval ttlbil = *zero
c eval rrn = *zero
c eval rrn2 = *zero
c dou rrn2 >= 40
c eval rrn = rrn + 1
c eval rrn2 = rrn2 + 1
c rrn chain subf1
c if itno = *blanks
c leave
c endif
c itno chain sprinv 88
c rrn2 chain subf2 89
c eval inumb = itno
c eval crptn = desc
c eval quant = qty1
c eval uprice = price
c eval salamt = quant * uprice
c update subf2
c eval subttl = subttl + salamt
c eval tax = subttl * .05
c eval ttlbil = subttl + tax
c enddo
c endsr
C*-----------UPDATE ROUTINE FOR SPRINV--------------------------------
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2+++++++RESULT++++++++LEN++D+HILOEQ
C ITEMUP BEGSR
C EVAL TAC = AVGCST * QUANT
C EVAL PFIT = SALAMT - TAC
C EVAL ONHAND = ONHAND - QUANT
C EVAL PROFIT = PROFIT + PFIT
C EVAL SOLD = SOLD + QUANT
C EVAL ICODE = 'U'
C UPDATE INVMAST
C ENDSR
C*---------- UPDATE ROUTINES FOR SPRCRF -----------------------------
C UPCRF BEGSR
C MOVE MYDATE TDATE
C CRFKEY CHAIN SPRCRF 80
C IF *IN80 = *ON
C EXSR SETREC2
C EXSR CR_ADD
C WRITE CARECPT
C ELSE
C EXSR CR_ADD
C UPDATE CARECPT
C ENDIF
C ENDSR
C*------------ PREPARE FILE FOR NEW RECORD ENTRY --------------------
C SETREC2 BEGSR
C EVAL CODE = *BLANK
C EVAL HWAMT = *ZEROS
C EVAL SGAMT = *ZEROS
C EVAL TAXAMT = *ZEROS
C EVAL CUSTNO = *BLANKS
C EVAL INVNO = *BLANKS
C EVAL CAMT = *ZEROS
C EVAL DAMT = *ZEROS
C EVAL ACCTNO = *ZEROS
C EVAL SAMT = *ZEROS
C ENDSR
C*----------- UPDATE AMOUNT FIELDS IN SPRCRF -------------------------
C CR_ADD BEGSR
C EVAL HWAMT = HWAMT + WARE
C EVAL SGAMT = SGAMT + SPORT
C EVAL TAXAMT = TAXAMT + TAX
C ENDSR
C*----------- UPDATE SPRGLF -------------------------------------------
C UPGLF BEGSR
C DO 6 X
C EVAL ACCT = ACCTNH(X)
C ACCT CHAIN SPRGLF 70
C SELECT
C WHEN X = 1
C EVAL BAL = BAL + SUBTTL
C WHEN X = 2
C EVAL BAL = BAL + WARE
C WHEN X = 3
C EVAL BAL = BAL + SPORT
C WHEN X = 4
C EVAL BAL = BAL + TAX
C WHEN X = 5
C EVAL BAL = BAL + WARE
C WHEN X = 6
C EVAL BAL = BAL + SPORT
C ENDSL
C UPDATE GENLED
C ENDDO
C ENDSR
C*------------ SEPERATION OF HARDWARE/S-GOODS BALANCES ---------------
C SEPRTE BEGSR
C MOVE ITEMNO NUMBR
C IF NUMBR = 'H'
C EVAL WARE = WARE + SALAMT
C ELSE
C EVAL SPORT = SPORT + SALAMT
C ENDIF
C ENDSR
C*------------- UPDATE FOR SPRSBC ------------------------------------
C UPSBC BEGSR
C CUSTNO CHAIN SPRSBC 75
C IF FORDER = D'0001-01-01'
C MOVE MYDATE FORDER
C IF LORDER = D'0001-01-01'
C MOVE MYDATE LORDER
C ELSE
C EVAL LORDER = MYDATE
C ENDIF
C ENDIF
C EVAL ORDPLA = ORDPLA + 1
C EVAL GRSSAL = GRSSAL + SUBTTL
C IF SUBTTL > LARORD
C EVAL LARORD = SUBTTL
C IF SUBTTL < SMAORD
C EVAL SMAORD = SUBTTL
C ENDIF
C ENDIF
C UPDATE SALCUST
C ENDSR
C*------------- UPDATES FOR SPRSBI -----------------------------------
C UPSBI BEGSR
C EVAL GRSSAL = GRSSAL + SALAMT
C EVAL NUMSLD = NUMSLD + QUANT
C EVAL SBIPRO = SBIPRO + PFIT
C ENDSR
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2Extended-FACTOR2++++++++++++++++++
C MYMONTH BEGSR
C SELECT
C WHEN MONTH1 = 01
C EVAL MYMONTH = 'JANUARY'
C WHEN MONTH1 = 02
C EVAL MYMONTH = 'FEBRUARY'
C WHEN MONTH1 = 03
C EVAL MYMONTH = 'MARCH'
C WHEN MONTH1 = 04
C EVAL MYMONTH = 'APRIL'
C WHEN MONTH1 = 05
C EVAL MYMONTH = 'MAY'
C WHEN MONTH1 = 06
C EVAL MYMONTH = 'JUNE'
C WHEN MONTH1 = 07
C EVAL MYMONTH = 'JULY'
C WHEN MONTH1 = 08
C EVAL MYMONTH = 'AUGUST'
C WHEN MONTH1 = 09
C EVAL MYMONTH = 'SEPTEMBER'
C WHEN MONTH1 = 10
C EVAL MYMONTH = 'OCTOBER'
C WHEN MONTH1 = 11
C EVAL MYMONTH = 'NOVEMBER'
C WHEN MONTH1 = 12
C EVAL MYMONTH = 'DECEMBER'
C ENDSL
C ENDSR
**CTDATA ACCTNH
1111
1116
1117
2117
4111
4113