midrange.com -- source code scratchpad

midrange.com code scratchpad
Name:
Old version of RPG program
Scriptlanguage:
Plain Text
Tabwidth:
Date:
01/25/2021 12:08:17 pm
IP:
Logged
Description:
Old version of RPG Program
Code:

    F*  

    F*

    FBA@IMTP   IP   E                          DISK                              INFSR(*PSSR)

    F*

    F*  

    F*

    F**BAIMGCP       IF   E               K DISK                            INFSR(*PSSR)

    FBAIMGCL          IF    E               K  DISK                           INFSR(*PSSR)

    F*

    F*    

    F*

    F**IRDLIFP    IF  E     K  DISK   INFSR(*PSSR)

    FIRDLIFL   IF  E            K DISK   INFSR(*PSSR)

    F*

    F*   

    F*

    F**SSGMCPP   IF  E    K DISK   INFSR(*PSSR)

    FSSGMCPL  IF  E        K DISK  INFSR(*PSSR)

    F*

     
    F*

    F**SSCYIFP   IF E  K DISK    INFSR(*PSSR)

    FSSCYIFL    IF   E   K DISK   INFSR(*PSSR)

    F                                                USROPN

    F*   

    F*

    FCM@LERP   IF   E                  K   DISK  INFSR (*PSSR)

    F                                                                  PREFIX(N@:2)

    F*

    F* 

    F*

    FINBA71R1      O    E                         PRINTER   USROPN

    F                                                                              INFDS(W1SF01)

    D*

    D* 

    D  BA@LPMP   E  DS

    D*

    D*

    D CYC                S                               9     DIM(500)

    D  DPF                S                               1      DIM(500)

    D*

    D                        DS

    DWSCYCD                              1            9

    DWBCTCD                               1           2

    DWBGMAB                              3           6

    D WBCYCD                              7           9

    D*

    D* File information Data structure for INBA71R1

    D*  W1SPNO -- Spool file No.

    D*  W1LCNT --- Current Line No,

    D*  W1PGNO  -Page No

    D*

    D W1SF01              DS

    D W1ST10                   *STATUS

    D  W1SPNO                         123                  124B     0

    D   W1LCNT                        367                  368B     0

    D W1PGNO                         369                  372B     0

    D*

    D  WSP601              E   DS

    D*  Data structure for header information

    D*

    D WSMSTS           DS

    D  W1MSTS                           1        2

    D    W1FILR                           3        3

    D    W1MGDS                        4      132

    D*

    D WSXR04          E   DS                      INZ

    D WSXR02          E  DS                       INZ

    D*

    D MSGS            S                40    DIM(3)    CTDATA   PERRCD(1)

    D*

    D*  

    D*

    D                             DS

    D W9ACNO                          1                     14

    D  W9ACB                             1                       3

    D   W9HPN1                          4                        4

    D   W9ACS                            5                     10

    D   W9HPN2                         11                    11

    D   W9ACX                           12                    14

    D*

    D* <CR><LF>

    D*

    D W0CRLF         DS

    D W0CR                          1                                               Carriage Return

    D W0LF                           1                                               Line Feed

    D*

    DMsgPtr                        S                      5P    0                  Msg  Pointer

    DTagEnd                       S                       5P    0                  Pos of end of tag

    DMsgEnd                      S                       5P    0                 Pos  of end of msg

    D*

    D/Copy SO1,XR02D

    D/Copy  SO1,XRZZ2D

    D*

    I/Eject

    I*

    i*  defining level break

     
    I*

     
    IBA@IMTR

    I                                                                  L@CTCD                    L2

    I                                                                  L@GMAB                   L2

    I                                                                  L@BRNO                    L1

    C/EJECT

     
    C***********************************************************************************

    C*

    C* Main Line logic

    C*

    C**************************************************************************************

    C   *IN91                    IFNE              W0ON

    C                                  EXSR            SR999

    C                                 END

    C*

    C   L2                         EXSR             SR005

    C   L1                         EXSR             SR050                                                                  Detail  Time Level Bk

    C*

    C                               EXSR             SR100                                                                    Detail  Time

    C                               EXSR             SR150

    C*

    C* 

    C*

    CL1   91                      EXSR    SR300                                                                            CT/GrpMbr Det  brk

    C

    C*

    CLR                             EXSR          SR998                                                                        Finalization

    C*

    C/EJECT

    C********************************************************************

    C*  Detail Time Level Break

    C**********************************************************************

    C*

    C  SR050                  BEGSR

    C                                EXSR                          SR250                                             Get Page Heading

    C                                MOVE                        W0ON                    W1NXPG

    C*

    C  W0OPEN              IFEQ        W0OFF

    C                                OPEN    INBA71R1

    C                                MOVE     W0ON                        W0OPEN

    C                                END

    C*

    C  SR050E                 ENDSR

    C*

    C/EJECT

    C*************************************************************************

    C*

    C*  Group Member Level Break

    C**************************************************************************

    C SR005                 BEGSR

    C                             MOVEL             L@CTCD                 K0CTCD

    C                             MOVEL             L@GMAB                K0GMAB

    C*

    C        K0GMCP                   CHAIN    SSGMCPR                                                            81

    C        *IN81                         IFEQ        W0OFF

    C                                           MOVEL     X2DFMT                    @02DTF

    C                                            ELSE

    C                                          MOVEL          'DMY'                    @02DTF

    C                                             ENDIF

    C           SR005E                     ENDSR

    C/EJECT

    C***************************************************************************

    C*

    C*Detail Time Processing

    C*

    C*****************************************************************************

    C     SR100                    BEGSR

    C*

    C      W0OPEN              IFEQ                     W0OFF                                                   Open   Report

    C                                    OPEN                    INBA71R1       

    C                                    MOVE                   W0ON                W0OPEN

    C                                    END

    C*

    C*Check for overflow

    C*

    C       W1LCNT              ADD                   W0DRSZ                      W0TEMP

    C        W0TEMP             IFGE                   W0PGLM

    C        W1NXPG            OREQ                  W0ON

    C                                     MOVE                 W0OFF                       W1NXPG

    C                                     ADD                     1                                   H1PGCT

    C                                    WRITE                  H07101

    C                                     WRITE                 H07102

    C                                     END

    C*

    C       SR100E                   ENDSR

    C/EJECT

    C****************************************************************************************

    C* Format Detail Line

    C****************************************************************************************

    C*

    C         SR150                  BEGSR

    C*

    C                                       MOVE                      *BLANKS                   D1TMTP                                                 

    C                                       MOVE                      *BLANKS                   D1TGMT                                                 

    C                                        MOVE                     *BLANKS                    D1SFMT                                                

    C                                       MOVE                       *BLANKS                   D1RCCY                                                 

    C                                       MOVE                       *BLANKS                   D1RAMT                                                 

    C                                       MOVE                        *BLANKS                   D1ACNO                                                

    C                                       MOVE                         *BLANKS                  D1FRBK                                                  

    C                                       MOVE                         *BLANKS                  D1FRBR                                                    

    C                                       MOVE                          *BLANKS                 D1VLDT                                                  

    C                                        MOVE                         *BLANKS                  D1AVWS                                                 

    C*                                         

    C                                        MOVEL(P)         L@MSG                   BA@LPMP

    C                                        MOVEL(P)          N4MURF                 D1TRNO                                                            Transaction Reference    

    C                                        MOVEL(P)           N4SFMT                 D1SFMT                                                             Transaction Reference  

    C                                         MOVEL(P)        L@UTRN                  D1UTRN                                                              UTR

    C*  Check if transaction constructed thru PI using Service ID

    C*

    C***                                         IF   %SUBST(L@UTRN:5:1) = W0P

    C* PI  Constructed message

    C**                                           ELSE

    C*L@UTRN                           CHAIN                BAIMGCR                              81

    C L@MGID                             CHAIN               BAIMGCR                               81

    C *IN81                                   IFEQ                   W0OFF

    C                                              MOVEL(P)       BHTMTP                          D1TMTP                                     

    C                                              MOVEL(P)      BHTGMT                          D1TGMT                                     

    C                                               MOVEL(P)     BHRCCY                           D1RCCY                                     

    C                                             MOVEL(P)      BHFRBK                            D1FRBK                                      

    C                                               MOVEL(P)    BHFRBR                             D1FRBR                                       

    C                                             MOVEL(P)      BHAVWS                             D1AVWS                                     

    C                                             MOVEL(P)     BHMSTS                             D1MSTS                                       

    C*

     
    C       N4MURF                    IFEQ      *ALL  'X'

    C                                            MOVEL(P)    BHTRNO               D1TRNO

    C                                           ENDIF

    C*

    C*Find decimal print  

    C                                         MOVEL    BHCTCD                     WBCTCD

    C                                         MOVEL    BHGMAB                     WBGMAB

    C                                         MOVEL    BHRCCY                      WBCYCD

    C                                          Z-ADD   W0PT1                            J

    C           WSCYCD              LOOKUP     CYC(J)                                                                95

    C          *IN95                      IFEQ              W0ON

    C                                           MOVE        DPF(J)     W1DPF

    C                                           END

    C                                          MOVE    W1DPF                 @04DEC

    C*

    C* Edit  Remittance  Amount

    C                                          Z-ADD     3                          @04NOC                        No of commas

    C                                          MOVEL          '4'                   @04TYP                         Print both +  &  -

    C                                          Z-ADD       BHRAMT           @04MUT                       Remittance  Amount

    C                                          CALLB         'XR04'              P0XR04

    C                 @04RET         IFNE                W0OK

    C                                        MOVEL        *ALL  '*'   D1RAMT

    C                                        ELSE

    C                                         MOVE          @04AMT                         D1RAMT

    C                                        ENDIF

    C*

    C                                       EVAL            W0RMT =  W0RAMT  +  BHRAMT

    C                                       EVAL            W0TTMG  =  W0TTMG  +1

     
    C*

    C* Edit Date received

    C                                       MOVE      L@XMDT                    @02IDT                           Value Date

    C                                       Z-ADD      9                                    @02LEN                          DDMMMYYYY

    C*

    C                                         CALLB       'XR02'           P0XR02

    C    @02RTC                      IFEQ             W0OK

    C                                         MOVEL          @02FDT             D1VLDT

    C                                          ELSE'

    C                                         MOVEL           *BLANKS            D1VLDT

    C                                         ENDIF

    C*

    C* 

    C*       L@UTRN               CHAIN        IRDLIFR                              81

    C          L@MGID              CHAIN        IRDLIFR                               81

    C      *IN81                          IFEQ           W0OFF

    C                                           IF   (IAPYAB <> *HIVAL  AND

    C                                                   IAPYAB <> *LOVAL

    C                                        MOVE          IAPYAB                W9ACB

    C                                         MOVE         '-'                           W9HPN1

    C                                        MOVE          IAPYAS                 W9ACS

    C                                        MOVE         '-'                             W9HPN2

    C                                        MOVE        IAPYAX                   W9ACX

    C*

    C                                        MOVEL       W9ACNO              D1ACNO

    C                                         ENDIF

    C                                         ENDIF

    C*

    C                                         ENDIF

    C***                                   ENDIF

    C                                         EXSR                 SR100

    C*

    C                                        IF  (N4SFMT = W0PIRP  OR

    C                                              N4SFMT = W0IFRP   OR

    C                                              N4SFMT = W0DRNT  OR

    C                                              N4SFMT = W0CRNT)

    C                                       MOVEL  W0IFN                D1TMTP                                           Trans. type

    C*

    C* Bypass Printing of PI/IFTP Notification  

    C*    -Can be activated   if required

    C                                             GOTO   SR150E

    C                                             ENDIF

    C*

    C                                             IF                     (L@ACKG   <>  *BLANKS  AND

    C                                                                      (N4SFMT  = W0PIRP  OR

    C                                                                      N4SFMT  = W0IFRP))

    C*                                        --Extract TRN  # from SFMS TAG 2020 (Tag 20)

    C                                             EVAL  MsgPtr  = %SCAN(W0T2020:N4MQMG:1)                              Tag  20  ?

    C                                             If   MsgPtr > 0                                                                                          Tag found

    C                                            Eval   TagEnd = %SCAN(W0CRLF:N4MQMG:(MsgPtr+6))                  where tag end ?

    C                                           If   TagEnd  >  0                                                                                          Tag Found

    C                                           Eval   D1TRNO  =  %SUBST(N4MQMG:MsgPtr+6:

    C                                                                               (TagEnd-MsgPtr-6)

    C                                           ENDIF

    C                                           ENDIF

    C                                           ENDIF

    C*

    C                                          WRITE                              D07101                                                                Detail Line

    C*

    C*  PI/IFTP  Response  including  DR/CR Notification Messages

    C                                     MOVE    *BLANKS   D2RMKS

    C*

    C*Check for NAK   Messages and print the reason

    C*

    C   L@ACKG                          IFNE            *BLANKS

    C*

    C         L@NKCD                 CHAIN          CM@LERR                                                           81

    C         *IN81                        IFEQ              W0OFF  

    C*                                          MOVEL     N@ERN1                         D2RMKS

    C                                            EVAL    D2RMKS  = L@NKCD  + W0DASH  +N@ERN1

    C                                            ENDIF

    C                                            ELSE

    C                                           IF                 N4SFMT = W0DRNT

    C                                           MOVEL(P)  MSG(2)                         D2RMKS

    C                                            ELSE

    C                                             IF           N4SFMT  = W0CRNT

    C                                           MOVEL(P)  MSGS(3)               D2RMKS

    C                                           ELSE

    C                                            IF                   (N4SFMT  = W0PIRP  OR

    C                                                                     N4SFMT   =  W0IFRP)

    C                                             IF              %SST(L@UTRN:5:1) = W0P

    C                                           MOVEL(P)    MSGS(1)              D2RMKS

    C                                             ENDIF

    C                                             ENDIF

    C                                              ENDIF

    C                                               ENDIF

    C                                               ENDIF

    C*

    C          D2RMKS                     IFNE                    *BLANKS

    C                                               WRITE                 D07102

    C                                               ENDIF

    C*

    C         SR150E                        ENDSR

    C/EJECT

    C****************************************************************

    C*Get report heading information                                                                               *

    C****************************************************************

    C*

    C  SR250                                  BEGSR

    C*

    C                                               MOVEL             W0RPID                    UVRPID                                                   Report ID

    C                                               MOVE               L@BRNO                   UVBRNO                                                

    C                                               MOVEL             L@CTCD                   UVCTCD                                                

    C                                               MOVEL             L@GMAB                  UVGMAB                                               

    C*

    C                                               CALLB            'SP601'                         P0601                                          99

    C*

    C                                              MOVE              UVCTCD                     H1CTCD

    C                                              MOVE               UVGMAB                    H1GMAB

    C                                              MOVE              L@BRNO                     H1BRNO                                                   

    C                                              MOVE             UVRPID                         H1RPID                                                       Report Id.

    C                                              MOVE             UVRPNM                      H1RPNM                                                    Report Name 

    C                                             MOVE               UVTDFD                       H1TDFD                                                     Today's Full Date

    C                                             TIME

    C                                              MOVEL           W0TIME                       H1TIME                                                       Report Time

    C                                            MOVE                 UVMFIN                     H1MFIN                                                    Microfiche  retent cde

    C*

    C                                             Z-ADD                    0                              H1PGCT                                                        Reset Page

    C*

    C           SR250E                           ENDSR

    C/EJECT

    C********************************************************************************************************

    C*                                                                                                                          *

    C********************************************************************************************************

    C*  

    C           SR300                            BEGSR

    C*

    C         H1PGCT                           IFGT                             0

    C         W1LCNT                          ADD                             W0EDSZ                       W0TEMP

    C         W0TEMP                           IFGE                          W0PGLM        

    C                                                   ADD                             1                                      H1PGCT                                   New  Page

    C                                                    WRITE                      H07101

    C                                                     END

    C*                                                                                                                                                                               Write Ending

    C                                                  EXSR                         SR350                        

    C*

    C                                                   WRITE     T07102                                                                                                 Write Ending

    C                                                    END

    C*

    C         W0OPEN                          IFEQ                              W0ON

    C                                                    MOVE                           W0OFF                         W0OPEN

    C*

    C                                                   CLOSE                      INBA71R1

    C                                                    Z-ADD                  *ZEROS                     H1PGCT                                                   Close  Report New Page

    C                                                    END

    C*

    C       W0OPEN                              IFEQ                   W0ON

    C                                                     MOVE                  W0OFF                       W0OPEN

    C*

    C                                                     CLOSE            INBA71R1

    C                                                      Z-ADD           *ZEROS                       H1PGCT

    C                                                       END

    C*

    C                                                      Z-ADD                *ZEROS                   W0RAMT

    C                                                      Z-ADD                *ZEROS                    W0TTMG

    C*

    C     SR300E                                     ENDSR

    C/EJECT

    C****************************************************************************

    C* Total Line at Total Time break                                                                                                      *

    C*

    C       SR350                                      BEGSR

    C*

    C                                                        MOVE                          W1DPF                   @04DEC

    C*

    C* Edit Total  Remittance  Amount

    C                                                        Z-ADD           3                        @04NOC                           No of commas

    C                                                        MOVEL          '4'                      @04TYP                             Print both +  &  -

    C                                                        Z-ADD          W0RAMT          @04MUT                             Remittance Amount

    C                                                        CALLB         'XR04'                P0XR04

    C              @04RET                            IFNE               W0OK

    C                                                         MOVEL         *ALL '*'            T1RAMT                              Amount

    C                                                        ELSE

    C                                                        MOVE           @04AMT           T1RAMT                             Amount

    C                                                        ENDIF

    C*

    C*Edit Total Messages

    C                                                         MOVE            *ZERO                 @04DEC

    C                                                         Z-ADD            W0TTMG             @04MUT

    C                                                         Z-ADD            2                            @04NOC

    C                                                         MOVEL           *ZERO                 @04TYP

    C                                                         MOVE            *BLANK               @04PCH

    C                                                         CALLB           'XR04'                    P0XR04

    C    @04RET                                      IFEQ                W0OK

    C                                                         MOVE            @04AMT                T1TTMG

    C                                                          ELSE

    C                                                          MOVE            W0TTMG               T1TTMG

    C                                                          END

    C*

    C                                                     WRITE               T07101                                                     Write Ending

    C       SR350E                                 ENDSR

    C/EJECT

    C*****************************************************************************************

    C*  Finalization

    C*

    C********************************************************************************************

    C    SR998                                       BEGSR

    C*

    C                                                      RETURN

    C*

    C   SR998E                                      ENDSR

    C*

    C/EJECT

    C**********************************************************************************************

    C*

    C*    Initialization

    C*

    C*************************************************************************************************

    C     SR999                              BEGSR

    C*

    C       *LIKE                            DEFINE                UVRPID                        W0RPID

    C       *LIKE                            DEFINE                 W1SPNO                      W0SPNO

    C       *LIKE                            DEFINE                  H1PGCT                       W0PGCT

    C       *LIKE                             DEFINE                L@CTCD                      K0CTCD

    C       *LIKE                             DEFINE                L@GMAB                       K0GMAB

    C       *LIKE                             DEFINE                XRCDPF                       W1DPF                                                 Dec  Prt

    C       *LIKE                             DEFINE                N4SFMT                         W0PIRP                                               PI Response

    C       *LIKE                             DEFINE                N4SFMT                         W0IFRP                                               IFTP  Response

    C       *LIKE                             DEFINE                 N4SFMT                        W0DRNT                                            IFTP  Response

    C       *LIKE                              DEFINE               N4SFMT                         W0CRNT                                            IFTP   Response

    C*

    C      P0XR04                              PLIST

    C                                                  PARM                                     WSXR04

    C*

    C        P0XR02                             PLIST                                                                                                                   For SP601

    C                                                   PARM                                     WSP601

    C*

    C* Entry Level Parameters

    C        *ENTRY                              PLIST

    C                                                    PARM                                      W0RPTP                            1

    C                                                    PARM                                       W0FRTM                          6

    C                                                     PARM                                      W0TOTM                          6

    C*

    C* Define Key  list parameters

    C        K0GMCP                            KLIST                                                                                

    C                                                    KFLD                                  K0CTCD           

    C                                                    KFLD                                  K0GMAB

    C*

    C* Define Constant  Variables  

    C*

    C                                                MOVEL           W0ON                     W0ON                        1

    C                                                MOVEL            W0OFF                   W0OFF                       1

    C                                                MOVEL           '1'                               W0ON

    C                                                MOVEL           '0'                                W0OFF

    C                                               MOVEL            'Y'                              W0YES

    C                                                MOVEL          'N'                                W0NO                      1

    C                                                MOVEL           '0'                               W0OK                       1

    C                                               MOVEL            'S'                               W0S                           2                   Sending

    C                                               MOVEL            'T'                               W0T                            2                   Sending

    C                                               MOVEL            'E'                                W0E                           2                    Error

    C                                               MOVEL            'C'                               W0C                           2                   Cancelled

    C                                                MOVEL           'P'                                W0P                            2                   Cancelled

    C                                               MOVEL           'PR'                              W0PR                         2                     Pending Repair

    C                                                MOVEL          'PA'                              W0PA                           2                  Pending Approval

    C                                               MOVE            ':2020:'                         W0T2020                      6                 

    C                                               MOVE          '298R90'                        W0PIRP                                             PI Response Msg Type

    C                                               MOVE          '298R09'                        W0IFRP                                             IFTP Response Msg Type

    C                                               MOVE          '298R43'                         W0DRNT                                          Debit  Notification

    C                                                MOVE         '298R44'                        W0CRNT                                           Credit Notification

    C                                               MOVE          'ACK'                             W0ACK                         3

    C                                                MOVE         'NAK'                            W0NAK                          3

    C                                                MOVE         'IFN'                              W0IFN                            3

    C                                                MOVEL        '-'                                    W0DASH                      1

    C                                                 BITOFF         '01234567'                   W0CR

    C                                                 BITOFF         '01234567'                   W0LF

    C                                                 BITON          '457'                              W0CR                                                        Carriage    Return

    C                                                 BITON          '257'                               W0LF                                                         Line  Feed

    C                                                 Z-ADD           60                                  W0PGLM             3    0                           Page Limit

    C                                                 Z-ADD           2                                    W0DRSZ              3    0                           Detail  Rec  Size  1

    C                                                 Z-ADD           3                                    W0EDSZ               3    0                          Ending  Rec  Size

    C                                                 MOVE                   *BLANKS             W0SIN                  1            Service Identifier.  H-> Host,P-> PI

    C*

    C* Define Non-Constant  Variables

    C*

    C                                                  Z-ADD                   *ZERO                      W0PT1             5   0

    C                                                  Z-ADD                   *ZERO                      W0TIME           6   0                              Report Time

    C                                                  Z-ADD                    *ZERO                     W0TEMP          6   0                           Temp Linee Counter

    C                                                   Z-ADD                  *ZERO                       W0RAMT        16  0                           Total remittance Amount

    C                                                 Z-ADD                     *ZERO                      W0TTMG           5  0                           Total Message Count

    C                                                  Z-ADD                     *ZERO                       I                        3   0                            Counter

    C                                                  Z-ADD                   *ZERO                         J                        5   0                             Table Index

    C                                                   Z-ADD                   *ZERO                        K                       5   0                              Index variable

    C                                                    Z-ADD                 *ZEROS                        W1LCNT   

    C                                                   MOVEL                W0OFF                        W1PRHC            1

    C                                                   MOVEL                 W0OFF                        W1PRHD            1

    C                                                    MOVELL               W0OFF                       W1PRHT             1

    C                                                   MOVEL                  W0OFF                        W0OPEN            1                                Report   open

    C                                                   MOVEL                   W0OFF                       W1NXPG             1                               Next   page

    C*

    C*  Define  Date Conversion  fields

    C                                                    Z-ADD               7                   @02LEN                                    Date Length

    C                                                    MOVEL             'DMY'            @02DTF                                    Date  Format

    C*

    C* Set on Initialization Indicator

    C                                                     MOVE      W0ON                 *IN91

    C*

    C* Initialize Report ID

    C                                                     IF    (W0RPTP  = 'F' )

    C                                                     MOVEL   'INBA71R1'           W0RPID                       Report  ID  - Full

    C                                                     ELSE

    C                                                     MOVEL    'INBA76R1'           W0RPID                      Report ID - Incremental

    C                                                     ENDIF

    C*

    C* Format Additional Header Details - Time  Range

    C                                                      IF     (W0RPTP  <> 'F'

    C                                                      EVAL  H1RMKS = 'FROM ' +

    C                                                                                     %SUBST(W0FRTM:1:2)  + ':' +

    C                                                                                      %SUBST(W0FRTM:3:2) + ':'  +

    C                                                                                      %SUBST(W0FRTM:5:2) +

    C                                                                                        ' TO '  +

    C                                                                                        %SUBST(W0TOTM:1:2) + ':' +

    C                                                                                         %SUBST(W0TOTM:3:2) + ':' +

    C                                                                                        %SUBST(W0TOTM:5:2)

    C                                                          ENDIF

    C*

    C* 

    C                                                          Z-ADD              500      J

    C*

    C**                                                       OPEN                SSCYIFP                                   81

    C                                                            OPEN               SSCYIFL                                    81

    C                                                            READ               SSCYIFR                                         81

    C*

    C          *IN81                                      DOWNE            W0ON

    C            J                                             ANDGT             *ZERO

    C                                                          MOVEL           XRCTCD                      WBCTCD

    C                                                          MOVEL           XRGMAB                       WBGMAB

    C                                                          MOVEL             XRCYCD                      WBCYCD

    C                                                          MOVE               XRCDPF                        DPF(J)

    C                                                          SUB                    1                                        J

    C*

    C                                                          READ                SSCYIFR                                           81

    C                                                          END

    C*

    C            J                                               ADD                 1                         W0PT1

    C            W0PT1                                    IFGT                 500

    C                                                            SUB                  1                         W0PT1

    C                                                            MOVE               *LOVAL            CYC(J)

    C                                                            MOVE                *LOVAL            DPF(J)

    C                                                            END

    C*

    C**                                                       CLOSE   SSCYIFP

    C                                                           CLOSE   SSCYIFL

    C*

    C       SR999E                                         ENDSR

    C*

    C/EJECT

    C/COPY  SRC1,XRZZ2C

    ** MESSAGE Fields -MSGS

    PI  constructed message                                                                1

    Debit  Notification                                                                         2

    Credit  Notification                                                                        3
generated in 0.012s
valid xhtml & css