midrange.com code scratchpad
Name:
CL
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
01/05/2021 02:38:09 pm
IP:
Logged
Description:
Hi,

How can we modify below program in such a way that it should run for all the possible values of BRNOs and we want to keep CTCD and GMAB to have static values and program should pickup system's date and should run everyday for previous day's data in it file let's say it should run at 00:15 am every day so that it could generate report based on previous day's data from the system.

Thanks
Code:
  1. DCL VAR (&WSCCR1 &WSCCR2 & CTCD &GMAB &BRNO +
  2.                  &REPORT  &FRMTME  &TOTME  &W1DATE)
  3.  
  4. DCL  VAR(&WSCCR1) TYPE(*CHAR) LEN(512)
  5. DCL  VAR(&WSCCR2) TYPE(*CHAR) LEN(2048)
  6. DCL VAR(&CTCD) TYPE(*CHAR) LEN(2)
  7. DCL VAR(&GMAB)  TYPE(*CHAR) LEN(4)
  8. DCL VAR(&BRNO) TYPE(*CHAR) LEN(3)
  9. DCL VAR(&REPORT) TYPE(*CHAR) LEN(1)
  10. DCL VAR(&REPOPT) TYPE(*CHAR) LEN(1)
  11. DCL VAR(&FRMTME) TYPE(*CHAR) LEN(6)
  12. DCL VAR(&TOTME) TYPE(*CHAR) LEN(6)
  13. DCL VAR(&SELT1)  TYPE(*CHAR) LEN(175)
  14. DCL VAR(&WSPVCV) TYPE(*CHAR) LEN(10)
  15. DCL VAR(&WSPVPG) TYPE (*CHAR) LEN(10)
  16. DCL VAR(&WSNXCV) TYPE(*CHAR) LEN(10)
  17. DCL VAR(&WSNXFT) TYPE(*CHAR) LEN(5)
  18. DCL VAR(&WSNXPG) TYPE(*CHAR) LEN(10)
  19. DCL VAR(&W1CV) TYPE(*CHAR) LEN(10)
  20. DCL VAR(&W1FT) TYPE(*CHAR) LEN(5)
  21. DCL VAR(&W1PG) TYPE(*CHAR) LEN(10)
  22. DCL VAR(&JOB) TYPE(*CHAR) LEN(10)
  23. DCL VAR(&BLANK) TYPE(*CHAR) LEN(1) VALUE (' ')
  24. DCL VAR(&TDDT) TYPE(*CHAR) LEN(8)
  25. DCL VAR(&W1DATE1) TYPE(*CHAR) LEN(6)
  26. DCL VAR (&W1DAATE2) TYPE(*CHAR) LEN(6)
  27. DCL VAR(&W1DATE3) TYPE(*CHAR) LEN(8)
  28. DCL  VAR(&WADATE4) TYPE(*CHAR) LEN(8)
  29. DCL VAR(&DATFMT) TYPE(*CHAR) LEN(3)
  30. DCL VAR (&W1YY) TYPE(*DEC) LEN(4 0)   /* Year YYYY*/
  31. DCL VAR (&W1YYC) TYPE(*CHAR) LEN(4) /*Char Year YYYY*/
  32. DCL VAR(&LIB) TYPE(*CHAR) LEN(5)
  33. DCL VAR(&LIB1) TYPE(*CHAR) LEN(8)
  34. DCL  VAR(&QRY) TYPE (*CHAR) LEN(350)
  35. DCL VAR(&P0QRY1) TYPE(*CHAR) LEN(2) VALUE('Q1')
  36. DCL VAR(&P0QRY2) TYPE (*CHAR) LEN(2) VALUE('Q2')
  37. DCL VAR(&P0QRY3) TYPE(*CHAR) LEN(2) VALUE('Q3')
  38.  
  39. RTVJOBA    JOB(&JOB)
  40. CHGVAR VAR(&WSNXCV)  VALUE(&WSCCR1  1 10))
  41. CHGVAR  VAR(&WSNXFT)   VALUE(&WSCCR1  11 5)
  42. CHGVAR(&WSNXPG)            VALUE(%SST(&WSCCR1 41 10)
  43.  
  44. CHGVAR VAR(&LIB) VALUE(QTEMP)
  45.  
  46. RTVDTAARA DTAARA(HSSDTAAR002 (1 8) ) RTNVAR(&DTDT)
  47. RTVDTAARA  DTAARA(HSSDTAR045  (1 8)   RTNVAR(&LIB1)
  48. RTVSYSVAL  SYSVAL(QDAT)  RTNVAR(&W1DATE1)
  49. RTVSYSVAL  SYSVAL(QDATFMT)  RTNVAR(&DATFMT)
  50.  
  51. IF  COND(&DATFMT  *EQ  'YMD') THEN (DO)
  52.  
  53. CHGVAR  VAR(&W1DATE2)  VALUE(%SST(&W1DATE1  1  6)
  54. ENDDO
  55.  
  56. IF  COND(&DATFMT  *EQ 'MDY' ) THEN (DO)
  57.  
  58. CHGVAR  VAR(&W1DATE2) VALUE(%SST(&W1DATE1  5 2) *TCAT +
  59.      %SST(&W1DATE1  1  4))
  60. ENDDO
  61.  
  62. IF  COND(&DATFMT *EQ 'DMY')  THEN (DO)
  63. CHGVAR  VAR(&W1DATE2)  VALUE(%SST(&W1DATE1 5  2)  *TCAT +
  64.  
  65. %SST(&W1DATE1  3 2) *TCAT  %SST(&W1DATE1  1  2))
  66. ENDDO
  67.  
  68. /*Format the system date from YYMMDD to YYYYMMDD    */
  69.  
  70. IF  COND(%SST(&W1DATE2  3 2) *LE %SST(&TDDT 5 +
  71.            2))  THEN (DO)
  72. CHGVAR  VAR(&W1DATE3)  VALUE  (%SST (&TDDT  1 2) *TCAT  +
  73.                     %SST(&W1DATE2  1 6)
  74. ENDDO
  75.  
  76. /*  Determine selection criteria          */
  77.  
  78. IF  COND (&REPOPT = 'F' ) THEN (DO)
  79. IF COND (&BRNO *NE '    ') THEN (CHGVAR  +
  80.        VAR(&SELT1)  VALUE('L@CTCD  *EQ  " ' || &CTCD  +
  81.          || ' " *AND  L@GMAB  *EQ " '  || &GMAB  || ' "  +
  82.         *AND  L@BRNO  *EQ ' ||  &BLANK  || ' " '))
  83.  
  84. ELSE    CMD(CHGVAR  VAR(&SELT1)  VALUE ('L@CTCD  *EQ  " ' +
  85.                 || &CTCD  ||  ' " *AND  L@GMAB   *EQ   " '|| &BLANK  ||  +
  86.                 &GMAB  ||  ' " *AND  L@ACKG  *EQ  " '||  &BLANK  ||  +
  87.                 ' " '))
  88.  
  89. ENDDO
  90.  
  91. ELSE CMD(DO)
  92.  
  93. IF         COND(&BRNO *NE '    ') THEN(CHGVAR +
  94.                   VAR(&SELT1) VALUE('L@CTCD  *EQ " '  ||  &CTCD  +
  95.                   ||  ' " *AND  L@GMAB  *EQ  "  '  || &GMAB   ||  ' "  +
  96.                   *AND  L@BRNO  *EQ '  || &BRNO  || '   *AND +
  97.                  L@ACKG  *EQ  " '  ||  &BLANK   || ' "    *AND +
  98.                 L@XMDT   *EQ   '|| &W1DATE   ||  '  *AND  L@XMTM  +
  99.                *GE   ' ||  &FRMTME  ||  '  *AND  L@XMTM  *LE '+
  100.               ||  &TOTME   || '  '))
  101.  
  102. ELSE     CMD(CHGVAR   VAR(&SELT1)  VALUE ('L@CTCD  *EQ " '  +
  103.                  ||  &CTCD  || ' " *AND  L@GMAB  *EQ  " '  || +
  104.                 &GMAB  ||  '"  *AND  L@ACKG   *EQ " '   ||  &BLANK  +
  105.                  || ' " *AND  L@XMDT   *EQ   '|| &W1DATE   ||  '  +
  106.                 *AND   L@XMTM  *GE   ' ||  &FRMTME   || '    *AND  +
  107.                 L@XMTM  *LE  ' ||  &TOTME   ||  '  '))
  108.  
  109. OVRPRTF   FILE(INBA71R1) SAVE(*YES)  SPLFNAME(INBA76R1)
  110. ENDDO
  111.  
  112. IF COND (&W1DATE  *EQ &W1DATE3) THEN (DO)  +
  113.  
  114. CHKOBJ    OBJ(QTEMP/BA@IMTP)  OBJTYPE(*FILE)
  115. MONMSG      MSGID(CPF9801)  EXEC (DO)
  116. CRTDUPOBJ   OBJ(BA@IMTP)  FROMLIB (*LIBL)  OBJTYPE(*FILE)  +
  117.                            TOLIB(QTEMP)  NEWOBJ(BA@IMTP)   CST(*NO)  +
  118.                            TRG(*NO)   ACCTL(*NONE)
  119.  
  120.  
  121. ENDDO
  122.  
  123. CALL   PGM(INBA071M)  PARM(&W1DATE   &P0QRY1)
  124.  
  125. OVRDBF  FILE(BA@IMTP)  TOFILE(QTEMP/BA@IMTP)  +
  126.                    OVRSCOPE(*JOB)  SHARE(*YES)
  127.  
  128. OPNQRYF  FILE((QTEMP/BA@IMTP))  QRYSLT(&SELT1)  +
  129.                     KEYFLD(L@CTCD)  (L@GMAB)  (L@BRNO))
  130.  
  131.  
  132. CALL    PGM(INBA071A)  PAR(&REOPT  &FRMTME  &TOTME)
  133.  
  134. CLOF  OPNID(BA@IMTP)
  135. DLTOVR  FILE(*ALL)
  136. RCLRSC
  137. CLRPFM  FILE(QTEMP/BA@IMTP)
  138. ENDDO
  139.  
  140. IF  COND(&W1DATE  *LE  &W1DATE3)  THEN(DO)    +
  141.  
  142. OVRPRTF   FILE(INBA71R1)  SAVE(*YES)  SPLFNAME(INBA76R1)
  143.  
  144. CHKOBJ   OBJ(QTEMP/BA@IMHP)  OBJTYPE(*FILE)
  145.  
  146. MONMSG    MSGID(CPF9801)   EXEC (DO)
  147. CRTDUPOBJ  OBJ(BA@IMHP)  FROMLIB(*LIBL)   OBJTYPE(*FILE)  +
  148.                          TOLIB(QTEMP)  NEWOBJ(BA@IMHP)  CST(*NO)
  149.                           TRG(*NO)   ACCTL(*NONE)
  150.  
  151. ENDDO
  152.  
  153. CALL  PGM(INBA071M)  PARM(&W1DATE   &P0QRY2)
  154. CALL  PGM(INBA071M)  PARM(&W1DATE  &P0QRY3)
  155.  
  156. OVRDBF   FILE(BA@IMHP)  TOFILE(QTEMP/BA@IMHP) +
  157.                    OVRSCOPE(*JOB)   SHARE(*YES)
  158. OPNQRYF    FILE((QTEMP/BA@IMHP)) QRYSLT(&SELT1)  +
  159.                      KEYFLD((L@CTCD) (L@GMAB) (L@BRNO))
  160.  
  161. CALL   PGM(INBA071B)  PARM (&REOPT  &FRMTME   &TOTME)
  162.  
  163. CLOF     OPNID(BA@IMHP)
  164.  
  165. DLTOVR    FILE(*ALL)
  166. RCLRSC
  167. /* End of today date */
  168.  
  169. CLRPFM  FILE(QTEMP/BA@IMHP)
  170.  
  171. CHGVAR  VAR(&W1CV)  VALUE(&WSNXCV)
  172. CHGVAR   VAR(&W1FT)   VALUE(&WSNXFT)
  173. CHGVAR    VAR(&W1PG)  VALUE(&WSNXPG)
  174. CHGVAR  VAR(&WSNXPG)  VALUE('*HIGHR')
  175. CHGVAR  VAR(&WSPVCV)  VALUE(&W1CV)
  176. CHGVAR     VAR(&WSPVFT)   VALUE(&W1FT)
  177. CHGVAR     VAR(&WSPVPG)  VALUE(&W1PG)
  178.  
  179.  
  180. CHGVAR   VAR(%SST (&WSCCR1  1  10))  VALUE(&WSNXCV)
  181. CHGVAR   VAR(%SST(&WSCCR1  11 5))  VALUE(&WSNXFT)
  182. CHGVAR    VAR(%SST (&WSCCR1 16 10)) VALUE(&WSNXPG)
  183.  
  184. CHGVAR   VAR(%SST(&WSCCR1 26  10)) VALUE(&WSPVCV)
  185. CHGVAR   VAR(%SST(&WSCCR1  36  5))  VALUE(&WSPVFT)
  186. CHGVAR    VAR(%SST(&WSCCR1  41  10))  VALUE(&WSPVPG
  187.  
  188.  
  189. EXITPGM:            RETURN
  190.                               ENDPGM
  191.  
  192.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css