|
midrange.com
Ok I have tried this four times and keep screwing up....
Here is the @#@#@# code:
**************************************************************************
* ORIGINAL DATE: 12/02/2005
* APPLICATION NAME: General Journal Entry Program
* PROGRAM NAME: GJENTRY
* DESCRIPTION: 1.Display Subfile 2.
* 3.
* 4.
*
**************************************************************************
* LOG OF MODIFICATIONS
*
* DATE PGMR DESCRIPTION
*----------------------------------------------------------------------
---
* / /
**************************************************************************
* FUNCTION OF INDICATORS
*
* IND FUNCTION
*----------------------------------------------------------------------
---
* 04 DISPLAY GL ACCOUNT LIST IN SUBFILE
* 12 CANCEL PROGRAM
**************************************************************************
* SUBROUTINE INDEX
**************************************************************************
* LOAD - SUBROUTINE TO LOAD SUBFILE
* VCHECK - SUBROUTINE FOR VALIDITY CHECK
**************************************************************************
* FILES
**************************************************************************
FACCOUNTINGCF E WORKSTN
F SFILE(GJENTRYSF:RRN)
F SFILE(CHRTDSPSFL:RN)
FCHRTACCTS IF E K DISK
FGENJOURNALIF A E DISK
FCHRTLF IF E K DISK
**************************************************************************
* STANDALONE VARIABLES
**************************************************************************
DRRN S 5S 0
DRN S 5S 0
DDTEMP S 10A
DDI s 10s 0 INZ(1)
DDCOUNT S 10S 0
DDCALCCT S 10S 0
DDTMPDATE S 8S 0
DDTMPREF S 10A
DDTMPDESC S 15A
DDTMPDEBIT S 11S 2
DDTMPCREDIT S 11S 2
**************************************************************************
* MAINLINE
**************************************************************************
C EXSR LOAD
C DOU *IN12 = *ON
C WRITE GJENTRYFTR
C EXFMT GJENTRYCTL
C WRITE GJENTRYCTL
C SELECT
C WHEN *IN04 = *ON
C READC GJENTRYSF
C EXSR LOADCA
C
C WHEN *IN06 = *ON
C READC GJENTRYSF
C EXSR ADDROW
C
C WHEN *IN10 = *ON
C EXSR FILUPD
C
C OTHER
C READC GJENTRYSF
C EXSR VCHECK
C ENDSL
C ENDDO
C EVAL *INLR = *ON
C RETURN
**************************************************************************
* CALCBAL SUB-ROUTINE
**************************************************************************
C CALCBAL BEGSR
C EVAL DDRTOTAL = 0
C EVAL DCRTOTAL = 0
C EVAL DCALCCT = 1
C DOW DCALCCT <= DCOUNT
C DCALCCT CHAIN GJENTRYSF
C EVAL DDRTOTAL = DDRTOTAL + DDEBIT
C EVAL DCRTOTAL = DCRTOTAL + DCREDIT
C EVAL DCALCCT = DCALCCT + 1
C ENDDO
C IF DDRTOTAL = DCRTOTAL
C EVAL DSTATUS = 'IN-BALANCE'
C ELSE
C EVAL DSTATUS = 'OUT-OF-BALANCE'
C ENDIF
C ENDSR
**************************************************************************
* FILUPD SUB-ROUTINE
**************************************************************************
C FILUPD BEGSR
C DOW DI <= DCOUNT
C DI CHAIN GJENTRYSF
C MOVE DDATE GLDATE
C MOVE DREF GLREF
C MOVE DACCTNO GLACCTNO
C MOVE DDESC GLDESC
C MOVE DDEBIT GLDEBIT
C MOVE DCREDIT GLCREDIT
C WRITE GL
C EVAL DI = DI + 1
C ENDDO
C EVAL *IN12 = *ON
C ENDSR
**************************************************************************
* ADDROW SUB-ROUTINE
**************************************************************************
C ADDROW BEGSR
C EXSR CALCBAL
C MOVE 00000000 DDATE
C MOVE 000000 DACCTNO
C EVAL RRN = RRN + 1
C EVAL DCOUNT = DCOUNT + 1
C WRITE GJENTRYSF
C ENDSR
**************************************************************************
* VCHECK SUB-ROUTINE
**************************************************************************
C VCHECK BEGSR
C DACCTNO CHAIN CHRT
C IF %FOUND
C EXSR CALCBAL
C ENDIF
C ENDSR
**************************************************************************
* LOAD SUB-ROUTINE
**************************************************************************
C LOAD BEGSR
C EVAL *IN52 = *ON
C WRITE GJENTRYCTL
C MOVE 00000000 DDATE
C MOVE 000000 DACCTNO
C ADD 1 RRN
C EVAL DCOUNT = DCOUNT + 1
C WRITE GJENTRYSF
C EVAL *IN51 = *ON
C ENDSR
**************************************************************************
* LOADCA SUB-ROUTINE
**************************************************************************
C LOADCA BEGSR
C *LOVAL SETLL CHRTLF
C EVAL *IN62 = *ON
C WRITE CHRTDSPCTL
C EVAL *IN62 = *OFF
C READ CHT
C DOW NOT %EOF
C MOVEL ACCTNO DWDWACCTNO
C MOVEL DESCRIP DWDWDESC
C MOVEL DESC DWDWCLSS
C ADD 1 RN
C WRITE CHRTDSPSFL
C READ CHT
C ENDDO
C EVAL *IN61 = *ON
C EXFMT CHRTDSPCTL
C EXSR RESPOND
C ENDSR
**************************************************************************
* RESPOND SUB-ROUTINE
**************************************************************************
C RESPOND BEGSR
C READC CHRTDSPSFL
C RRN CHAIN GJENTRYSF
C MOVE DWDWACCTNO DACCTNO
C UPDATE GJENTRYSF
C ENDSR
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
