midrange.com -- source code scratchpad

midrange.com code scratchpad
Name:
New RPG version
Scriptlanguage:
Plain Text
Tabwidth:
Date:
01/25/2021 11:51:53 am
IP:
Logged
Description:
New RPG version for Report Automation
Code:

    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**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*

    F*INBA71R1      O    E                         PRINTER   USROPN

    F*                                                                              INFDS(W1SF01)

    FINBA71P              UF    A    E           DISK            USROPN

     
     
    D*

    D* 

    D  BA@LPMP   E  DS

    D*

    D*

    D CYC                S                               9     DIM(500)

    D  DPF                S                               1      DIM(500)

    D*

    D* 

    D                         DS

    DWSCYCD                              1            9

    DWBCTCD                               1           2

    DWBGMAB                              3           6

    D WBCYCD                              7           9

    D*

    D*Data Structure for Header information

    D WSP601              E    DS

    D*

    D WSMSTS            DS

    D W1MSTS            1               2

    D  W1FILR             3               3

    D*

    D* Data structure for header information

    D WSHDR1                     DS

    D  W1HDR1                                 1              40

    D   W1HDR2                               41             80                  INZ('REPORT')

     
    D W1HDR3                                 81             90

    D W1DATE                                 91             98

    D W1HDR4                               101           105

    D  W1TIME                               106           115

    D  W2TIME                 DS

    D  W0HH                                       1             2

    D   W0MM                                    3             4

    D  W0SS                                        5             6

    D*

    DWSHDR2                    DS

    D W2HDR1                                   1              20                 INZ('Ref No')

    D W2HDR2                                  21            40                  INZ('UT No.')

    DW2HDR3                                   41             48                INZ('MSG Type')

    D W2HDR4                                  49             58                INZ('Tr Type')

    D W2HDR5                                  59             61                INZ('Ccy')

    D W2HDR6                                  62             70                INZ('Amt')

    D  W2HDR7                                 71              84               INZ('AC')

    D W2HDR8                                  85            100              INZ('Drdt')

    D W2HDR9                                 101           110              INZ('Value Date')

    D W2HDR10                               111            130              INZ('Approval Workstation')

    D*

    D* Detail Line data structure

    D WSDTL1                                 DS

    D WSREFNO                                  1                   16

    D WSTRNO                                   17                   38

    D  WSMSTYP                                39                    41

    D  WSTRTYP                                 42                    44

    D   WSSFMS                                  45                   50

    DWSCCY                                      51                    53

    D WSAMT                                     54                    66           2

    D WSACT                                     67                    80

    D  WSBK                                      81                    84

    D WSBR                                        85                    88

    D WSVD                                       89                    97

    D WSAWS                                    98                    107

    D WSRMKS                                 108                  132

    D*

    D* DS for End of Report Footer 1

    D*

    D WSFTR1                           DS

    D WSFIL1                                         1                 10

    D  WSTXT1                                     11                 35

    D  WSFIL2                                       36                37

    D  WSMSG                                       38                42

    D*

    D* DS for End of Report Footer 2

    D WSFTR2                          DS

    D*

    D WSFIL3                                        1                10

    D WSTXT2                                      11                31

    D WSFIL4                                        32              38

    D  WSTRAM                                    39              59

    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*

    D MsgPtr                               S                      5P      0                                                             Msg Pointer

    D  TagEnd                              S                      5P      0                                                             Pos of end of tag

    D MsgEnd                             S                       5P      0                                                             Pos of end of msg

     
    D/COPY   SRC1,XR02D

    D/COPY   SRC1,XRZZ2D

    D*

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

    C* Main Line logic

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

    C   *INZSR                    BEGSR

    C                                     EXSR                 SR999

    C                                     OPEN                 INB71P

    C* Write header Details

    C*

    C                                    EXSR              SR001

    C* WRITE Transactions details

    C                                     EXSR             SR002

    C*Write  End of Report details

    C                                     EXSR             SR003

    C*

    C                                      CLOSE         INBA71P                                                     Close the download report file

    C                                      RETURN

    C                                      ENDSR

    C*

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

    C*    Write the Header Details in the file 

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

    C     SR001                    BEGSR

    C                                    TIME                        W0TIME

    C                                     EVAL              W2TIME  = %CHAR(W0TIME)

    C                                     EVAL               W1TIME = W0HH + ':'  + W0MM + ':'  + W0SS

    C                                     MOVE         P@XMDT            W1DATE                            Date  in the Header

    C                                     MOVEL(P)   WSHDR1              IF@TXT

    C                                     EVAL    IF@TXT   = %TRIM(IF@TXT)  +  W0CRLF

    C                                     WRITE    INBA71PR

    C                                    MOVEL(P)           WSHDR2          IF@TXT

    C                                    EVAL             IF@TXT  = %TRIM (IF@TXT)  +W0CRLF

    C                                      WRITE             INBA71PR

    C   SR001E                     ENDSR

    C/EJECT

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

    C* Write the Details of all the transactions     

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

    C*

    C   SR002                         BEGSR

    C                                       CLEAR                           WSDTL1

    C                                       DOW        NOT  %EOF (BA@IMTP)

    C                                       READ                 BA@IMTR

    C                                       MOVEL(P)         L@MSG                   BA@LPMP

    C                                       MOVEL(P)         N4MURF                 WSTRNO                                                            

    C                                       MOVEL(P)          N4SFMT                 WSSFMS                                                              

    C                                       MOVEL(P)          L@UTRN                 WSTRNO                                                              

    C L@MGID                      CHAIN               BAIMGCR                               81

    C *IN81                            IFEQ                   W0OFF

    C                                        MOVEL(P)       BHTMTP                          WSTRTYP                                     

    C                                        MOVEL(P)      BHTGMT                          WSMSTYP                                     

    C                                        MOVEL(P)     BHRCCY                           WSCCY                                          

    C                                        MOVEL(P)      BHFRBK                           WSBK                                            

    C                                        MOVEL(P)    BHFRBR                             WSBR                                             

    C                                        MOVEL(P)      BHAVWS                          WSAWS                                         

    C                                        MOVEL(P)     BHMSTS                             WSMSTS                                      

    C*              

    C       N4MURF                    IFEQ      *ALL  'X'

    C                                            MOVEL(P)    BHTRNO               WSTRNO

    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  '*'   WSAMT

    C                                        ELSE

    C                                         MOVE          @04AMT                         WSAMT

    C                                        ENDIF

    C*

    C                                       EVAL            W0RMT =  W0RAMT  +  BHRAMT

    C                                       EVAL            W0TTMG  =  W0TTMG  +1

     
    C*

    C* Edit Date received

    C                                       MOVE      P@XMDT                    @02IDT                           Value Date

    C                                       Z-ADD      9                                    @02LEN                          DDMMMYYYY

    C*

    C                                         CALLB       'XR02'           P0XR02

    C    @02RTC                      IFEQ             W0OK

    C                                         MOVEL          @02FDT             WSVD

    C                                          ELSE

    C                                         MOVEL           *BLANKS            WSVD

    C                                         ENDIF

    C*

    C* Find out Payment A/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*

    C                                        IF  (N4SFMT = W0PIRP  OR

    C                                              N4SFMT = W0IFRP   OR

    C                                              N4SFMT = W0DRNT  OR

    C                                              N4SFMT = W0CRNT)

    C                                       MOVEL  W0IFN                WSTRTYP                                           Trans. type

    C*

    C* Bypass Printing of PI/IFTP Notification  

    C*    -Can be activated   if required

     
    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*  PI/IFTP  Response  including  DR/CR Notification Messages

    C                                     MOVE    *BLANKS   WSRMKS

    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                         WSRMKS

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

    C                                            ENDIF

    C                                            ELSE

    C                                           IF                 N4SFMT = W0DRNT

    C                                           MOVEL(P)  MSG(2)                         WSRMKS

    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)              WSRMKS

    C                                             ENDIF

    C                                             ENDIF

    C                                              ENDIF

    C                                               ENDIF

    C                                               ENDIF

    C*

    C                                             MOVEL (P)     WSDTL1                           IF@TXT

    C                                              EVAL                IF@TXT   = %TRIM(IF@TXT)  + W0CRLF

    C                                             WRITE            INBA71PR

     
    C                                               ENDDO

     
    C   SR002E                              ENDSR

    C/EJECT

    C*

    C    SR003                              BEGSR

    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 '*'            WSTRAM                              Amount

    C                                                 ELSE

    C                                                 MOVE           @04AMT           WSTRAM                             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                WSTMSG

    C                                                          ELSE

    C                                                          MOVE            W0TTMG               WSTMSG

    C                                                          END

    C                                                         MOVEL(P)       WSFTR1              IF@TXT

    C                                                          EVAL             IF@TXT    = %TRIM (IF2TXT)  + W0CRLF

    C                                                           WRITE           INBA71PR

    C                                                          MOVEL(P)         WSFTR2            IF@TXT

    C                                                          EVAL                 IF@TXT    = %TRIM(IF@TXT)   W0CRLF

    C                                                         WRITE           INBA71PR

    C     SR003E                                  ENDSR

    C/EJECT

    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   P0XR02                                PLIST

    C                                                 PARM                                     WSXR02

    C                                                 PARM                                       @02M

    C*

    C  P0601                                    PLIST                                                                                                                   For SP601

    C                                                PARM                                      WSP601         

    C* Entry Level Parameters

    C   *ENTRY                              PLIST

    C                                                PARM                                    L@CTCD                                        2

    C                                               PARM                                     L@GMAB                                        4

    C                                               PARM                                    P@BRNO                                         3

    C                                                PARM                                   P@XMDT                                         8

    C* Define Key list parameters

    C    K0GMCP                             KLIST      

    C                                                 KFLD                                      K0CTCD                                               

    C                                                  KFLD                                     K0GMAB

    C* Define Constant   Variables

    C*

    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*

    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* 

    C* Initialize Report ID

    C                                                     MOVEL   'INBA71R1'           W0RPID                       Report  ID  - Full

    C* Load Currency Information

    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                                                     81

    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.011s
valid xhtml & css