*=========================================================================
* RPG Original Source Code for Pgm. MMACTIV
*=========================================================================
*
* Print Activity Report showing activity in 1994 thru 1996 but
* no activity in 1997.. in seq. by Terr. Code and Account Name
* To Run Report:
* Under SSS take Options 3-3-11 and run procedure MMACTIVITY
* to create a file called MMFILE.SSSRMFDTA
* Then Copy MMFILE.SSSRMFDTA to MMFILEP.SSS, Then Run Program...
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
FMMFILEP IF E DISK
F MMFILE KRENAMEMMFL
FQSYSPRT O F 132 PRINTER
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
* SSS Procedures produce outfiles with only one field in them
* so MMFILX is a DS which breaks down that one field
* into the data fields needed in this programs
I DS
I 1 200 MMFILX
I 1 5 ATERR
I 9 38 ANAME
I 48 530ACTCDT
I 71 720ACTYY
I 71 760ACTDAT
* RDATE and WKDATE are used to format the date for the report
IRDATE DS
I 1 20HDMM
I 3 3 SL1
I 4 50HDDD
I 6 6 SL2
I 7 80HDYY
IWKDATE DS
I 1 70WKDT
I 2 30WKMM
I 4 50WKDD
I 6 70WKYY
* Program Status Data Structure Page: 43 of the RPG/400 Reference
I SDS
I 1 10 PROGNM
I 254 263 USER
I 270 2750DATE1
I 276 2810DATE2
I 288 2930DATE3
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C Z-ADDDATE1 WKDT
C MOVELWKYY HDYY Set
C MOVELWKMM HDMM Report
C MOVELWKDD HDDD Date
C MOVEL'/' SL1
C MOVEL'/' SL2
C Z-ADD99 LCT 30 Line Counter
C Z-ADD*ZEROS ACT94 50 Init.
C Z-ADD*ZEROS ACT95 50 Yearly
C Z-ADD*ZEROS ACT96 50 Totals
C Z-ADD*ZEROS ACT97 50
C Z-ADD*ZEROS ACT98 50
C Z-ADD*ZEROS ACTTT 50 # Act.Recs.Per.Acct.
C Z-ADD*ZEROS HADATE 60 Hold Acct. Date
C MOVE *BLANKS HANAME 30 Hold Acct. Name
C MOVE *BLANKS HTERR 5 Hold Terr. Code
C MOVE 'N' DONE 1 Main Loop Switch
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C DONE DOWEQ'N' B001 Main Loop
C READ MMFILEP 98 Read File
C *IN98 IFEQ '1' Test EOF
C MOVE 'Y' DONE Exit
C GOTO ENDLOP Main Loop
C END
C MOVELMMFILE MMFILX Break Down MSM Rec.
C ANAME IFNE HANAME Acct. Name not =
C EXSR CHKACT Hold Acct. Name
C END Exec Check.Acct.
C ADD 1 ACTTT # Act.Recs.Per.Acct.
C ACTDAT IFGT HADATE Acct.Date >
C Z-ADDACTDAT HADATE Hold Acct.Date
C END
C SELEC Add one to Totals
C ACTYY WHEQ 94 Based on
C ADD 1 ACT94 which Year
C ACTYY WHEQ 95 the Activity
C ADD 1 ACT95 took
C ACTYY WHEQ 96 place
C ADD 1 ACT96 1994
C ACTYY WHEQ 97 thru
C ADD 1 ACT97 1998
C ACTYY WHGT 98
C ADD 1 ACT98
C ENDSL
C ENDLOP TAG
C ENDDO E001 End Main Loop
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C MOVE '1' *INLR End Program
C RETRN Return
* --------------------------------------------------------------------
C CHKACT BEGSR Check Account Record
C ACTTT IFEQ *ZEROS # Act.Recs.Per.Acct.
C GOTO CHKEND Used for a
C END First Time Switch
C ACT95 IFGT 0 Checking Yearly
C ACT96 ANDGT0 Totals > Zeros
C ACT97 ANDEQ0 to Print a Line
C ACT98 ANDEQ0 of the Report
C ADD 1 LCT Add to Line Counter
C LCT IFGT 61 Checking Overflow
C EXCPTHEAD Write Headers
C Z-ADD5 LCT Init. Line Counter
C END
C EXCPTDET1 Write Detail Line
C END
C CHKEND TAG Set Fields for Next
C MOVE ANAME HANAME Set Hold Acct. Name
C MOVE ATERR HTERR Set Hold Terr. Code
C Z-ADD*ZEROS ACT94 Init. Yearly
C Z-ADD*ZEROS ACT95 Total Fields
C Z-ADD*ZEROS ACT96 1994
C Z-ADD*ZEROS ACT97 thru
C Z-ADD*ZEROS ACT98 1998
C Z-ADD*ZEROS ACTTT # Act.Recs.Per.Acct.
C Z-ADD*ZEROS HADATE Init. Hold Acct.Date
C CHKEXT ENDSR
* ------------------------------------------------------------------------
OQSYSPRT E 1 HEAD
O +000 'PGM.Name: '
O PROGNM +000
O +015 'Accounts with Activity'
O +000 ' in 1995 and 1996'
O +000 ' but no Activity in'
O +000 ' 1997'
OQSYSPRT E 1 HEAD
O +000 'Run Date: '
O RDATE +000
OQSYSPRT E 2 HEAD
O +000 'Terr.'
O +001 'Account Name '
O +000 ' '
O +002 '94 Act.'
O +003 '95 Act.'
O +003 '96 Act.'
O +003 '97 Act.'
O +003 'TOT.Act'
O +003 'Last.Act.Date'
OQSYSPRT E 11 HEAD
O +000 '-----'
O +001 '--------------------'
O +000 '----------'
O +002 '-------'
O +003 '-------'
O +003 '-------'
O +003 '-------'
O +003 '-------'
O +003 '-------------'
OQSYSPRT E 1 DET1
O HTERR +000
O HANAME +001
O ACT94 J +002
O ACT95 J +003
O ACT96 J +003
O ACT97 J +003
O ACTTT J +003
O HADATEY +006
*=========================================================================
*=========================================================================
* RPG New Source Code for Pgm. MMACTIV
*=========================================================================
FMMFILEP IF E DISK
F MMFILE KRENAMEMMFL
FQSYSPRT O F 0132 OA PRINTER
IRDATE DS 8
I 1 20HDMM
I 3 3 SL1
I 4 50HDDD
I 6 6 SL2
I 7 80HDYY
IWKDATE DS 7
I 1 70WKDT
I 2 30WKMM
I 4 50WKDD
I 6 70WKYY
I DS
I 1 200 MMFILX
I 1 5 ATERR
I 9 38 ANAME
I 48 530ACTCDT
I 71 720ACTYY
I 71 760ACTDAT
I SDS
I *PROGRAM PROGNM
I 254 263 USER
I 270 2750DATE1
I 276 2810DATE2
I 288 2930DATE3
C Z-ADDDATE1 WKDT
C Z-ADDWKYY HDYY
C Z-ADDWKMM HDMM
C Z-ADDWKDD HDDD
C MOVEL'/' SL1
C MOVEL'/' SL2
C Z-ADD99 LCT 30
C Z-ADD0 ACT94 50
C Z-ADD0 ACT95 50
C Z-ADD0 ACT96 50
C Z-ADD0 ACT97 50
C Z-ADD0 ACT98 50
C Z-ADD0 ACTTT 50
C Z-ADD0 HADATE 60
C MOVE *BLANKS HANAME 30
C MOVE *BLANKS HTERR 5
C MOVE 'N' DONE 1
C DONE DOWEQ'N'
C READ MMFILEP 98
C *IN98 IFEQ '1'
C MOVE 'Y' DONE
C GOTO ENDLOP
C END
C MOVELMMFILE MMFILX
C ANAME IFNE HANAME
C EXSR CHKACT
C END
C ADD 1 ACTTT
C ACTDAT IFGT HADATE
C Z-ADDACTDAT HADATE
C END
C SELEC
C ACTYY WHEQ 94
C ADD 1 ACT94
C ACTYY WHEQ 95
C ADD 1 ACT95
C ACTYY WHEQ 96
C ADD 1 ACT96
C ACTYY WHEQ 97
C ADD 1 ACT97
C ACTYY WHEQ 98
C ADD 1 ACT98
C END
C ENDLOP TAG
C END
C MOVE '1' *INLR
C RETRN
C CHKACT BEGSR
C ACTTT IFEQ 0
C GOTO CHKEND
C END
C ACT95 CABLE0 CHKEND
C ACT96 CABLE0 CHKEND
C ACT97 CABNE0 CHKEND
C ACT98 CABNE0 CHKEND
C ADD 1 LCT
C LCT IFGT 61
C EXCPTHEAD
C Z-ADD5 LCT
C END
C EXCPTDET1
C CHKEND TAG
C MOVE ANAME HANAME
C MOVE ATERR HTERR
C Z-ADD0 ACT94
C Z-ADD0 ACT95
C Z-ADD0 ACT96
C Z-ADD0 ACT97
C Z-ADD0 ACT98
C Z-ADD0 ACTTT
C Z-ADD0 HADATE
C CHKEXT ENDSR
OQSYSPRT E 0001 HEAD
O 10 'PGM.Name: '
O PROGNM 20
O 57 'Accounts with Activity'
O 74 ' in 1995 and 1996'
O 93 ' but no Activity in'
O 98 ' 1997'
OQSYSPRT E 1 HEAD
O 10 'Run Date: '
O RDATE 18
OQSYSPRT E 2 HEAD
O 5 'Terr.'
O 26 'Account Name '
O 36 ' '
O 45 '94 Act.'
O 55 '95 Act.'
O 65 '96 Act.'
O 75 '97 Act.'
O 85 'TOT.Act'
O 101 'Last.Act.Date'
OQSYSPRT E 11 HEAD
O 5 '-----'
O 26 '--------------------'
O 36 '----------'
O 45 '-------'
O 55 '-------'
O 65 '-------'
O 75 '-------'
O 85 '-------'
O 101 '-------------'
OQSYSPRT E 1 DET1
O HTERR 5
O HANAME 36
O ACT94 45 ' , 0 -'
O ACT95 55 ' , 0 -'
O ACT96 65 ' , 0 -'
O ACT97 75 ' , 0 -'
O ACTTT 85 ' , 0 -'
O HADATEY 99
OQSYSPRT D 0006 OA
*=========================================================================
*=========================================================================
* NOP-RPG New Source Code for Pgm. MMACTIV
*=========================================================================
FMMFILEP IF E DISK
F MMFILE KRENAMEMMFL
FQSYSPRT O F 0132 OA PRINTER
IMMFL
I MMFILE
IMMFILE DS 0999
I 00010200 C012
I DS 0275
I I P000100020AK
I I P000300050AA
I I P000600080AB
I I P000900110AC
I I P001200240AD
I I P001500170AE
I I P001800200AF
I 00250054 C004
I 00550059 C003
I 00600060 C005
I 00610065 C013
I 00610260 C010
I 00690098 C006
I 013101320AL
I 013101360AH
I 02610268 C002
I 02630263 C008
I 02640265 C007
I 02660266 C009
I 02670268 C011
I 026902750AI
I 027002710AM
I 027202730AN
I SDS 0429
I 00010010 C001
I 027002750AJ
C Z-ADDAJ AI
C MOVE AI C011
C MOVELAM C002
C MOVE AN C007
C MOVE '/' C008
C MOVE '/' C009
C Z-ADD99 AK
C Z-ADD*ZEROS AA
C Z-ADD*ZEROS AB
C Z-ADD*ZEROS AC
C Z-ADD*ZEROS AD
C Z-ADD*ZEROS AE
C Z-ADD*ZEROS AF
C Z-ADD*ZEROS AG 60
C MOVE *BLANKS C004
C MOVE *BLANKS C003
C MOVE 'N' C005
C TA0009 TAG
C C005 CABNE'N' TA0001
C READ MMFILEP 98
C *IN98 CABNE'1' TAG013
C MOVE 'Y' C005
C GOTO TA0002
C TAG013 TAG
C MOVE C012 C010
C C006 CABEQC004 TA0003
C EXSR SBR001
C TA0003 TAG
C ADD 1 AF
C AH CABLEAG TA0004
C MOVE AH AG
C TA0004 TAG
C AL CABNE94 TA0005
C ADD 1 AA
C GOTO TA0002
C TA0005 TAG
C AL CABNE95 TA0006
C ADD 1 AB
C GOTO TA0002
C TA0006 TAG
C AL CABNE96 TA0007
C ADD 1 AC
C GOTO TA0002
C TA0007 TAG
C AL CABNE97 TA0008
C ADD 1 AD
C GOTO TA0002
C TA0008 TAG
C AL CABLE98 TA0002
C ADD 1 AE
C TA0002 TAG
C GOTO TA0009
C TA0001 TAG
C MOVEL'1' *INLR
C RETRN
C SBR001 BEGSR
C AF CABNE0 TA0010
C GOTO TA0011
C TA0010 TAG
C AB CABLE0 TA0011
C AC CABLE0 TA0011
C AD CABNE0 TA0011
C AE CABNE0 TA0011
C ADD 1 AK
C AK CABLE61 TA0012
C EXCPTHEAD
C Z-ADD5 AK
C TA0012 TAG
C EXCPTDET1
C TA0011 TAG
C MOVE C006 C004
C MOVE C013 C003
C Z-ADD*ZEROS AA
C Z-ADD*ZEROS AB
C Z-ADD*ZEROS AC
C Z-ADD*ZEROS AD
C Z-ADD*ZEROS AE
C Z-ADD*ZEROS AF
C Z-ADD*ZEROS AG
C ENDSR
OQSYSPRT D 6 OA
OQSYSPRT E 1 HEAD
O 10 'PGM.Name: '
O C001 20
O 57 'Accounts with Activity'
O 74 ' in 1995 and 1996'
O 93 ' but no Activity in'
O 98 ' 1997'
OQSYSPRT E 1 HEAD
O 10 'Run Date: '
O C002 18
OQSYSPRT E 2 HEAD
O 5 'Terr.'
O 26 'Account Name '
O 36 ' '
O 45 '94 Act.'
O 55 '95 Act.'
O 65 '96 Act.'
O 75 '97 Act.'
O 85 'TOT.Act'
O 101 'Last.Act.Date'
OQSYSPRT E 11 HEAD
O 5 '-----'
O 26 '--------------------'
O 36 '----------'
O 45 '-------'
O 55 '-------'
O 65 '-------'
O 75 '-------'
O 85 '-------'
O 101 '-------------'
OQSYSPRT E 1 DET1
O C003 5
O C004 36
O AA 45 ' , 0 -'
O AB 55 ' , 0 -'
O AC 65 ' , 0 -'
O AD 75 ' , 0 -'
O AF 85 ' , 0 -'
O AG 100 '0 / / '
