13. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/23/2018 6:40:19 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

13.1 Files compared

# Location File Last Modified
1 docs TAS epay US328 SDD - Copy.doc Mon Oct 22 16:27:48 2018 UTC
2 docs TAS epay US328 SDD - Copy.doc Mon Oct 22 16:33:23 2018 UTC

13.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 3 1496
Changed 2 4
Inserted 0 0
Removed 0 0

13.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

13.4 Active regular expressions

No regular expressions were active.

13.5 Comparison detail

  1   MCCF EDI T AS US328
  2   System Des ign Docume nt
  3   PRCA*4.5*x xx
  4  
  5   Department  of Vetera ns Affairs
  6   Nov 2017
  7   Version 1
  8   User Story  ID: US328
  9   User Story  Name:  Ne eds trace  numbers to  populate  the ePayme nts ERA
  10   Sizing:  3
  11   Epic Taxon omy eBiz C ompliance  Port Updat e    Incre ase No Tou ch  TAS Ap psStory
  12   As a...I w ant to...S o that...M anagement  userAdd Tr ace Number s to the e Payments E RA bulleti n bulletin s. Convers ation (if  desired by  developer s)
  13   ERA bullet in{
  14  
  15   PAPER:Matc hed/Not Po sted ERA>3 0 days
  16  
  17   EFT:Matche d/Not Post ed ERA>30  days
  18  
  19   Unmatched  ERAs > 30  days
  20   Summary:
  21   The above  bulletins  generated  by the sch eduled [PR CA NIGHTLY  PROCESS]  option wil l be modif ied to inc lude trace  number as  a separat e line.
  22   Existing r outine RCD PEM7 will  be modifie d.
  23   Resolution  – Added C hanged Obj ects 
  24   RoutinesAc tivitiesRo utine Name RCDPEM7Enh ancement C ategory Ne w Modify D elete No C hangeRTMRe lated Opti onsPRCA NI GHTLY PROC ESSRelated  RoutinesR outines “C alled By”R outines “C alled”   R CDPEM   DW ^%DTC              
  25      $$GET1^ DIQ           
  26      $$SITE^ VASITE        
  27      $$FMDIF F^XLFDT       
  28      $$FMTE^ XLFDT         
  29      $$FMTH^ XLFDT         
  30      $$NOW^X LFDT          
  31      $$UP^XL FSTR          
  32        SENDMSG^XM XAPI        Current Lo gic RCDPEM 7 ;OI D N
S           /PJH - OVE RDUE EFT A ND ERA BUL LETINS ;Ju n 06, 2014 @19:11:19
  33    ;;4.5;Acc ounts Rece ivable;**2 76,298,303 ,304,321** ;Mar 20, 1 995;Build  104
  34    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  35    ;
  36   EN ; Main  entry poin t for over due EFT/ER A bulletin s
  37    ;
  38    N TODAY,E RACNT,ERAT OT,ERA1CNT ,ERA2CNT,E RA1TOT,ERA 2TOT,EFTCN T,EFTTOT,R CPROG,RCSU SCNT,RCSUS AMT,RCMXDY S
  39    ;Clear wo rkfiles
  40    S RCPROG= "RCDPEM7"  K ^TMP(RCP ROG,$J)
  41    ;Set coun ters and t otals
  42    S (EFTCNT ,ERACNT,ER A1CNT,ERA2 CNT,EFTTOT ,ERATOT,ER A1TOT,ERA2 TOT,RCSUSC NT,RCSUSAM T)=0
  43    ;Cuttoff  of 12:00 a m today
  44    S TODAY=$ P($$NOW^XL FDT,".")
  45    ;
  46    ;Verify t his is cor rect day f or bulleti ns - PRCA* 4.5*321
  47    N X
  48    S X=TODAY
  49    D DW^%DTC
  50    I $$GET1^ DIQ(344.61 ,"1,",.1)' =X Q
  51    ;
  52    ;Retrieve  the max d ays allowe d in suspe nse parame ter
  53    S RCMXDYS =$$GET1^DI Q(342,"1," ,7.04)
  54    ;
  55    ;Scan for  overdue E RA and unp osted ERA
  56    D ERASCAN
  57    ;Scan for  overdue E FT
  58    D EFTSCAN
  59    ;Scan for  overdue S uspended E RA's - PRC A*4.5*304
  60    D SUSPSCA N
  61    ;Bulletin s
  62    D BULLETI N
  63    ;Clear wo rkfiles
  64    K ^TMP(RC PROG,$J)
  65    Q
  66    ;
  67   ERASCAN ;S can ERA
  68    N AMT,ERA IEN,REC0,S UB,STATUS, FDATE,PNAM E
  69    ;Scan for  unmatched  ERA
  70    S ERAIEN= 0,STATUS=0 ,SUB="ERA"
  71    F  S ERAI EN=$O(^RCY (344.4,"AM ATCH",STAT US,ERAIEN) ) Q:'ERAIE N  D
  72    .S REC0=$ G(^RCY(344 .4,ERAIEN, 0))
  73    .;Get ERA  file date /time
  74    .S FDATE= $P(REC0,U, 7) Q:'FDAT E
  75    .;Ignore  if <31 day s overdue
  76    .Q:$$FMDI FF^XLFDT(T ODAY,FDATE ,1)<31
  77    .;Trace,  Payer Name  and Amoun t
  78    .S PNAME= $P(REC0,U, 6),AMT=$P( REC0,U,5)
  79    .I $L(PNA ME)>35 S P NAME=$E(PN AME,1,35)  ; limit si ze of the  name
  80    .;Update  count and  totals
  81    .S ERACNT =ERACNT+1, ERATOT=ERA TOT+AMT
  82    . ; PRCA* 4.5*303 ad ded the FD ATE subscr ipt to the  global so  that the  line
  83    . ; items  collate i n date asc ending ord er.
  84    . ;Save E RA#, Payer  Name, Fil e Date and  Amount Pa id
  85    .S ^TMP(R CPROG,$J," ERA",FDATE ,ERACNT)=$ $ERAL(ERAI EN,PNAME,F DATE,AMT)
  86    ;
  87    ;Scan for  Matched/U nposted ER A
  88    S SUB="ER A1"
  89    F STATUS= -1,1,2,3 D
  90    . S ERAIE N=0 F  S E RAIEN=$O(^ RCY(344.4, "AMATCH",S TATUS,ERAI EN)) Q:'ER AIEN  D
  91    .. S REC0 =$G(^RCY(3 44.4,ERAIE N,0))
  92    .. ;Get E RA file da te/time
  93    .. S FDAT E=$P(REC0, U,7) Q:'FD ATE
  94    .. ;Ignor e if <31 d ays overdu e
  95    .. Q:$$FM DIFF^XLFDT (TODAY,FDA TE,1)<31
  96    .. ;Ignor e if not u nposted po sted
  97    .. Q:$P($ G(^RCY(344 .4,ERAIEN, 0)),U,14)> 0
  98    .. ;Payer  Name and  Amount
  99    .. S PNAM E=$P(REC0, U,6),AMT=$ P(REC0,U,5 )
  100    .. I $L(P NAME)>35 S  PNAME=$E( PNAME,1,35 ) ; limit  size of th e name
  101    .. ; PRCA *4.5*303 S plit into  "ACH" and  not "ACH"
  102    .. ;Updat e count an d totals
  103    .. S:$P(R EC0,U,15)= "ACH" ERA1 CNT=ERA1CN T+1,ERA1TO T=ERA1TOT+ AMT
  104    .. S:$P(R EC0,U,15)' ="ACH" ERA 2CNT=ERA2C NT+1,ERA2T OT=ERA2TOT +AMT
  105    .. ;PRCA* 4.5*303 ad ded the FD ATE subscr ipt to the  global so  that the  line
  106    .. ;items  collate i n date asc ending ord er.
  107    .. ;Save  ERA#, Paye r Name, Fi le Date an d Amount P aid
  108    .. S:$P(R EC0,U,15)= "ACH" ^TMP (RCPROG,$J ,"ERA1",FD ATE,ERA1CN T)=$$ERAL( ERAIEN,PNA ME,FDATE,A MT)
  109    .. S:$P(R EC0,U,15)' ="ACH" ^TM P(RCPROG,$ J,"ERA2",F DATE,ERA2C NT)=$$ERAL (ERAIEN,PN AME,FDATE, AMT)
  110    .. Q
  111    . Q
  112    Q
  113    ;
  114   EFTSCAN ;S can EFT
  115    N DEPN,EF TIEN,IEN34 43,EFTDATE ,TRACE,REC 0,REC31,RE C4,STATUS, PAYER,DEPA MT
  116    ;Scan for  unmatched  EFT
  117    S EFTIEN= 0,STATUS=0
  118    ; PRCA*4. 5*303 Chec k all stat uses repor t on unmat ched EFTs,  Matched E FTs with u nposted ER As
  119    ; 4-7-201 6 Removed  F STATUS=- 1,0,1 per  issue iden tifying du plicate EF Ts this wi ll need to  be
  120    ; address ed in anot her projec t
  121    S STATUS= 0 F  S EFT IEN=$O(^RC Y(344.31," AMATCH",ST ATUS,EFTIE N)) Q:'EFT IEN  D
  122    .S REC31= $G(^RCY(34 4.31,EFTIE N,0))
  123    .;PRCA*4. 5*303 Get  zero node  of the ass ociated ER A if match ed
  124    .S REC4=$ S($P(REC31 ,U,10)'="" :$G(^RCY(3 44.4,$P(RE C31,U,10), 0)),1:"")
  125    .;Get poi nter to EF T file
  126    .S IEN344 3=$P(REC31 ,U) Q:'IEN 3443
  127    .S REC0=$ G(^RCY(344 .3,IEN3443 ,0))
  128    .;Get EFT  file date
  129    .S EFTDAT E=$P(REC0, U,2) Q:'EF TDATE
  130    .;Ignore  if <15 day s overdue
  131    .Q:$$FMDI FF^XLFDT(T ODAY,EFTDA TE,1)<15
  132    .;PRCA*4. 5*303 - if  we have a  ERA check  to see if  we includ e this rec ord or qui t
  133    .I REC4'= "" Q:$P(RE C4,U,14)'= 0 ; Not po sted statu s is 0 - e verything  else is ig nored
  134    .;Deposit  number an d payment  amount
  135    .S DEPN=$ P(REC0,U,6 ),DEPAMT=$ P(REC31,U, 7)
  136    .;Payer I D and Trac e from EFT  detail fi le
  137    .S PAYER= $P(REC31,U ,2),TRACE= $P(REC31,U ,4) S:PAYE R="" PAYER ="NO PAYER  NAME RECE IVED" ; PR CA*4.5*298
  138    .;If paye r and trac e combined  are >40 t runcate pa yer name f irst
  139    .I $L(PAY ER_TRACE)> 40 D
  140    ..I $L(PA YER)>20 S  PAYER=$E(P AYER,1,20)  ; limit s ize of the  name
  141    ..Q:$L(PA YER_TRACE) <41
  142    ..S TRACE =$E(TRACE, 1,20) ; li mit size o f the trac e
  143    .;Update  count and  totals
  144    .S EFTCNT =EFTCNT+1, EFTTOT=EFT TOT+DEPAMT
  145    .; PRCA*4 .5*303 add ed EFTDATE  to the su bscripts b efore EFTC NT so repo rt will so rt in
  146    .; date a scending o rder.
  147    .;Save De posit No,  Receipt, P ayer ID, E FT Date an d Deposit  Amount
  148    .S ^TMP(R CPROG,$J," EFT",EFTDA TE,EFTCNT) =$$EFTL(DE PN,TRACE,P AYER,EFTDA TE,DEPAMT)
  149    Q
  150    ;
  151    ; PRCA*4. 5*304
  152    ; Scan fo r ERA's ol der than a llowed by  parameter
  153   SUSPSCAN ;
  154    N RCCT,RC DATA,RCSDA TE,RCDATA0 ,RCDATA2,R CDATA3,RCM AXDAY,RCRE CTDA,RCTRA NDA
  155    N RCDEP,R CTRACE,RCP AYER,RCEFT DT,RCDEPAM T,RCDAYS,R CUSER,RCRE C,RCDISP,R CRSN,RCSRE C
  156    ;
  157    ;initiali ze counter s
  158    S (RCSUSA MT,RCSUSCN T)=0
  159    ;
  160    ;calculat e the last  date to s top gather ing entrie s on
  161    S RCMAXDA Y=TODAY-RC MXDYS
  162    ;
  163    ;Loop thr ough the I n Suspense  index
  164    S (RCRECT DA,RCCT)=0
  165    F  S RCRE CTDA=$O(^R CY(344,"AN ",RCRECTDA )) Q:'RCRE CTDA  D
  166    . S RCDAT A=$G(^RCY( 344,RCRECT DA,0))
  167    . S RCREC =$P(RCDATA ,U)
  168    . S RCTRA NDA=0 F  S  RCTRANDA= $O(^RCY(34 4,"AN",RCR ECTDA,RCTR ANDA)) Q:' RCTRANDA   D
  169    . . S RCD ATA0=$G(^R CY(344,RCR ECTDA,1,RC TRANDA,0))
  170    . . S RCD ATA2=$G(^R CY(344,RCR ECTDA,1,RC TRANDA,2))
  171    . . S RCD ATA3=$G(^R CY(344,RCR ECTDA,1,RC TRANDA,3))
  172    . . ;get  date into  suspense
  173    . . S RCS DATE=$P(RC DATA3,U,2)
  174    . . S RCD AYS=$$FMTH ^XLFDT(TOD AY,1)-$$FM TH^XLFDT(R CSDATE,1)
  175    . . Q:RCS DATE=""
  176    . . ;
  177    . . ;if y ounger tha n the cuto ff date, q uit
  178    . . Q:RCD AYS'>RCMXD YS
  179    . . ;
  180    . . ; get  the user  and dispos ition
  181    . . S RCU SER=$$GET1 ^DIQ(200,$ P(RCDATA3, U,3)_",",1 ,"E")
  182    . . S RCD ISP=$$UP^X LFSTR($$GE T1^DIQ(344 .01,RCTRAN DA_","_RCR ECTDA_",", 3.01))
  183    . . ;
  184    . . ;Susp ense statu s has been  cleared q uit
  185    . . Q:$P( RCDATA2,U, 6)'="" 
  186    . . ;
  187    . . ;Extr act needed  info for  report
  188    . . S RCE FTDT=$P(RC DATA0,U,6) ,RCDEPAMT= $P(RCDATA0 ,U,4)
  189    . . ;
  190    . . ;upda te counter  and amoun t info
  191    . . S RCS USCNT=RCSU SCNT+1
  192    . . S RCS USAMT=RCSU SAMT+RCDEP AMT
  193    . . S RCR SN=$E($P($ G(^RCY(344 ,RCRECTDA, 1,RCTRANDA ,1)),U,2), 1,12)
  194    . . S RCS REC=RCREC_ "@"_RCTRAN DA
  195    . . ;
  196    . . ;upda te tempora ry array
  197    . . S ^TM P(RCPROG,$ J,"SUSPENS E",RCSDATE ,RCSUSCNT) =$$ESUSPL( RCSDATE,RC DAYS,RCUSE R,RCSREC,R CDEPAMT,RC DISP,RCRSN )
  198    ;
  199    Q
  200    ;
  201   BULLETIN ; Create bul letins onl y if overd ue EFT/ERA  found
  202    ;
  203    N ARRAY,S BJ,SUB,CNT ,CNT1,RCPR OG1,GLB,RC MXDYS,IDX
  204    S RCPROG1 ="RCDPEM7A ",GLB=$NA( ^TMP(RCPRO G1,$J,"XMT EXT"))
  205    ;
  206    ;Unmatche d ERA bull etins
  207    I ERACNT  D
  208    .;Build h eader
  209    .S SUB="E RA" K @GLB
  210    .S SBJ="E DI LBOX-ST A# "_$P($$ SITE^VASIT E,"^",3)_" -ACTION RE Q-Unmatche d ERAs > 3 0 days"
  211    .S @GLB@( 1)="The li sted ERAs  were recei ved more t han 30 day s ago and  have not y et been"
  212    .S @GLB@( 2)="matche d."
  213    .S @GLB@( 3)=" "
  214    .S @GLB@( 4)="Total  # of ERAs  - "_ERACNT
  215    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(ERAT OT,",",2)
  216    .S @GLB@( 6)=" "
  217    .S @GLB@( 7)="ERA# P AYER NAME  FILE DATE  AMOUNT PAI D"
  218    .;
  219    .;Move un matched ER A search f indings in to message
  220    .S CNT=0, CNT1=8,SUB ="ERA"
  221    .S IDX=""  F  S IDX= $O(^TMP(RC PROG,$J,SU B,IDX)) Q: 'IDX  F  S  CNT=$O(^T MP(RCPROG, $J,SUB,IDX ,CNT)) Q:' CNT  D
  222    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT)
  223    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  224    .D SEND
  225    .K @GLB
  226    ;
  227    ;Unposted  "ACH" ERA  bulletins
  228    ; PRCA*4. 5*303 - mo dified thi s bulletin  to show o nly "ACH"  expected p ayments
  229    I ERA1CNT  D
  230    .;Build h eader
  231    .S SUB="E RA1" K @GL B
  232    .; PRCA*4 .5*303 - C hanged SBJ  to make s ure it was  less than  65 charac ters
  233    .S SBJ="E DI LBOX-ST A# "_$P($$ SITE^VASIT E,"^",3)_" -ACTION RE Q-EFT:Matc hed/Not Po sted ERA>3 0 days"
  234    .S @GLB@( 1)="The li sted ERAs  were recei ved more t han 30 day s ago and  have been  matched bu t"
  235    .S @GLB@( 2)="have n ot been po sted"
  236    .S @GLB@( 3)=" "
  237    .S @GLB@( 4)="Total  # of ERAs  - ""MATCHE D TO EFT""  - "_ERA1C NT
  238    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(ERA1 TOT,",",2)
  239    .S @GLB@( 6)=" "
  240    .S @GLB@( 7)="ERA# P AYER NAME  FILE DATE  AMOUNT PAI D"
  241    .;
  242    .;Move un posted ERA  search fi ndings int o message
  243    .S CNT=0, CNT1=8,IDX =""
  244    .F  S IDX =$O(^TMP(R CPROG,$J,S UB,IDX)) Q :'IDX  F   S CNT=$O(^ TMP(RCPROG ,$J,SUB,ID X,CNT)) Q: 'CNT  D
  245    ..S CNT1= CNT1+1
  246    ..S @GLB@ (CNT1)=^TM P(RCPROG,$ J,SUB,IDX, CNT)
  247    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  248    .D SEND
  249    .K @GLB
  250    ;
  251    ;Unposted  "CHK" ERA  bulletins  or ERAs,  that don't  match "AC H"
  252    ; PRCA*4. 5*303 - mo dified thi s bulletin  to show " CHK" expec ted paymen ts (or don 't match " ACH")
  253    I ERA2CNT  D
  254    .;Build h eader
  255    .S SUB="E RA2" K @GL B
  256    .; PRCA*4 .5*303 - C hanged SBJ  to make s ure it was  less than  65 charac ters
  257    .S SBJ="E DI LBOX-ST A# "_$P($$ SITE^VASIT E,"^",3)_" -ACTION RE Q-PAPER:Ma tched/Not  Posted ERA >30 days"
  258    .S @GLB@( 1)="The li sted ERAs  were recei ved more t han 30 day s ago and  have been  matched bu t"
  259    .S @GLB@( 2)="have n ot been po sted"
  260    .S @GLB@( 3)=" "
  261    .S @GLB@( 4)="Total  # of ERAs  - ""MATCHE D TO PAPER  CHECK"" -  "_ERA2CNT
  262    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(ERA2 TOT,",",2)
  263    .S @GLB@( 6)=" "
  264    .S @GLB@( 7)="ERA# P AYER NAME  FILE DATE  AMOUNT PAI D"
  265    .;
  266    .;Move un posted ERA  search fi ndings int o message
  267    .S CNT=0, CNT1=8,IDX =""
  268    .F  S IDX =$O(^TMP(R CPROG,$J,S UB,IDX)) Q :'IDX  F   S CNT=$O(^ TMP(RCPROG ,$J,SUB,ID X,CNT)) Q: 'CNT  D
  269    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT)
  270    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  271    .D SEND
  272    .K @GLB
  273    ;
  274    ;Unmatche d EFT bull etins
  275    ; PRCA*4. 5*303 - Ch anged logi c to send  "No EFTs m ore than 1 4 days..."  message i f no EFTs
  276    ;I EFTCNT  D
  277    ;Build he ader
  278    S SUB="EF T" K @GLB
  279    S SBJ="ED I LBOX-STA # "_$P($$S ITE^VASITE ,"^",3)_"- ACTION REQ -EFTs > 14  days"
  280    I EFTCNT= 0 D  G B1
  281    . S @GLB@ (1)="****  There are  NO EFTs mo re than 14  days old  that have  not yet be en matched ."
  282    . S @GLB@ (2)=" "
  283    . S @GLB@ (3)="Total  # of EFTs  - "_EFTCN T
  284    . S @GLB@ (4)="Total  Dollar Am ount - $"_ $FN(0,",", 2)
  285    . S @GLB@ (5)=" "
  286    . S @GLB@ (6)="** EN D OF REPOR T **"
  287    ;
  288    I EFTCNT> 0 D
  289    .S @GLB@( 1)="The fo llowing EF Ts were re ceived mor e than 14  days ago a nd have no t yet"
  290    .S @GLB@( 2)="been m atched."
  291    .S @GLB@( 3)=" "
  292    .S @GLB@( 4)="Total  # of EFTs  - "_EFTCNT
  293    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(EFTT OT,",",2)
  294    .S @GLB@( 6)=" "
  295    .S @GLB@( 7)="DEPOSI T# PAYER N AME/TRACE#  EFT DATE  DEPOSIT AM T"
  296    .;
  297    .;Move EF T search f indings in to message
  298    .S CNT=0, CNT1=8,SUB ="EFT",IDX =""
  299    .F  S IDX =$O(^TMP(R CPROG,$J,S UB,IDX)) Q :'IDX  F   S CNT=$O(^ TMP(RCPROG ,$J,SUB,ID X,CNT)) Q: 'CNT  D
  300    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT)
  301    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  302   B1 ;
  303    D SEND
  304    K @GLB
  305    ;
  306    ;PRCA*4.5 *304 - Add  suspense  bulletin
  307    ; Suspens e bulletin s
  308    ;
  309    ; Send bu lletin if  items in s uspense
  310    I RCSUSCN T D
  311    . ;
  312    . N DT
  313    . ;Retrie ve the par ameter
  314    . S RCMXD YS=$$GET1^ DIQ(342,"1 ,",7.04)
  315    . ;
  316    . ;Build  header
  317    . S SUB=" SUSPENSE"  K @GLB
  318    . S SBJ=" EDI LBOX-S TA# "_$P($ $SITE^VASI TE,"^",3)_ "-SUSPENSE  ENTRIES O VERDUE FOR  PROCESSIN G"
  319    . S @GLB@ (1)="The f ollowing e ntries hav e been in  Suspense p ast the #d ays allowe d by site"
  320    . S @GLB@ (2)="param eter - whi ch is curr ently set  at "_RCMXD YS_" days. "
  321    . S @GLB@ (3)=" "
  322    . S @GLB@ (4)="Total  # of Over due Entrie s in Suspe nse - "_RC SUSCNT
  323    . S @GLB@ (5)="Total  Dollar Am ount Overd ue in Susp ense - "_" $"_$FN(RCS USAMT,",", 2)
  324    . S @GLB@ (6)=" "
  325    . S @GLB@ (7)="SUSP  DATE #DAYS  USER RECE IPT# AMOUN T DISP REA SON"
  326    . ;
  327    . ;Move S uspense se arch findi ngs into m essage
  328    . S CNT=0 ,CNT1=8,SU B="SUSPENS E",DT=0
  329    . F  S DT =$O(^TMP(R CPROG,$J,S UB,DT)) Q: 'DT  D
  330    . . F  S  CNT=$O(^TM P(RCPROG,$ J,SUB,DT,C NT)) Q:'CN T  D
  331    . . . S C NT1=CNT1+1 ,@GLB@(CNT 1)=^TMP(RC PROG,$J,SU B,DT,CNT)
  332    . S @GLB@ (CNT1+1)=" ** END OF  REPORT **"
  333    . D SEND
  334    . K @GLB
  335    Q
  336    ;
  337   SEND ;Tran smit mail  message
  338    N XMDUZ,X MTEXT,XMSU B,XMY,XMIN STR
  339    S XMDUZ=D UZ,XMTEXT= GLB,XMSUB= SBJ,XMY("I :G.RCDPE A UDIT")=""
  340    S XMINSTR ("FROM")=" POSTMASTER "
  341    S XMINSTR ("FLAGS")= "P"
  342    D SENDMSG ^XMXAPI(XM DUZ,XMSUB, XMTEXT,.XM Y,.XMINSTR )
  343    Q
  344    ;
  345   ERAL(X1,X2 ,X3,X4) ;F ormat ERA  Message li ne
  346    N SPACE
  347    S SPACE=$ J("",80)
  348    S X1=X1_$ E(SPACE,1, 12-$L(X1))
  349    S X2=X1_$ E(X2,1,43) _$E(SPACE, 1,43-$L(X2 ))
  350    S X3=$$FM TE^XLFDT(X 3,"2D")
  351    S X4="$"_ $FN(X4,"," ,2)
  352    Q X2_$J(X 3,8)_$J(X4 ,15)
  353    ;
  354   EFTL(X1,X2 ,X3,X4,X5)  ;Format E FT Message  line
  355    N SPACE
  356    S SPACE=$ J("",80)
  357    S X1=X1_$ E(SPACE,1, 10-$L(X1)) _" "
  358    S X2=X3_" /"_X2 ;Pay er and Tra ce
  359    S X2=X1_$ E(X2,1,41) _$E(SPACE, 1,42-$L(X2 ))
  360    S X4=$$FM TE^XLFDT(X 4,"2D")
  361    S X5="$"_ $FN(X5,"," ,2)
  362    Q X2_$J(X 4,8)_$J(X5 ,15)
  363    ;
  364    ;PRCA*4.5 *304
  365   ESUSPL(X1, X2,X3,X4,X 5,X6,X7) ; Format Sus pense Mess age line
  366    N SPACE
  367    S SPACE=$ J("",80)
  368    ;spacing  for Suspen se Date
  369    S X1=$$FM TE^XLFDT(X 1,"2D")
  370    S X1=X1_$ E(SPACE,1, 10-$L(X1))
  371    ;spacing  for # days  in suspen se
  372    S X2=$E(S PACE,1,6-$ L(X2))_X2
  373    ;spacing  for USER
  374    S X3=" "_ X3_$E(SPAC E,1,5-$L(X 3))
  375    ;spacing  for RECEIP T NUMBER_T RANS #
  376    S X4=$E(X 4_SPACE,1, 16)
  377    ;spacing  for amount  in suspen se
  378    S X5=$J(" $"_$FN(X5, ",",2),13) _" "
  379    ;spacing  for STATUS
  380    S X6=X6_$ E(SPACE,1, 12-$L(X6))
  381    ;spacing  for REASON
  382    S X7=X7_$ E(SPACE,1, 12-$L(X7))
  383    ;return c oncatenate d string
  384    Q X1_X2_X 3_X4_X5_X6 _X7
  385    ;Modified  Logic (Ch anges are  in bold) R CDPEM7 ;OI D N
S           /PJH - OVE RDUE EFT A ND ERA BUL LETINS ;Ju n 06, 2014 @19:11:19
  386    ;;4.5;Acc ounts Rece ivable;**2 76,298,303 ,304,321** ;Mar 20, 1 995;Build  104
  387    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  388    ;
  389   EN ; Main  entry poin t for over due EFT/ER A bulletin s
  390    ;
  391    N TODAY,E RACNT,ERAT OT,ERA1CNT ,ERA2CNT,E RA1TOT,ERA 2TOT,EFTCN T,EFTTOT,R CPROG,RCSU SCNT,RCSUS AMT,RCMXDY S
  392    ;Clear wo rkfiles
  393    S RCPROG= "RCDPEM7"  K ^TMP(RCP ROG,$J)
  394    ;Set coun ters and t otals
  395    S (EFTCNT ,ERACNT,ER A1CNT,ERA2 CNT,EFTTOT ,ERATOT,ER A1TOT,ERA2 TOT,RCSUSC NT,RCSUSAM T)=0
  396    ;Cuttoff  of 12:00 a m today
  397    S TODAY=$ P($$NOW^XL FDT,".")
  398    ;
  399    ;Verify t his is cor rect day f or bulleti ns - PRCA* 4.5*321
  400    N X
  401    S X=TODAY
  402    D DW^%DTC
  403    I $$GET1^ DIQ(344.61 ,"1,",.1)' =X Q
  404    ;
  405    ;Retrieve  the max d ays allowe d in suspe nse parame ter
  406    S RCMXDYS =$$GET1^DI Q(342,"1," ,7.04)
  407    ;
  408    ;Scan for  overdue E RA and unp osted ERA
  409    D ERASCAN
  410    ;Scan for  overdue E FT
  411    D EFTSCAN
  412    ;Scan for  overdue S uspended E RA's - PRC A*4.5*304
  413    D SUSPSCA N
  414    ;Bulletin s
  415    D BULLETI N
  416    ;Clear wo rkfiles
  417    K ^TMP(RC PROG,$J)
  418    Q
  419    ;
  420   ERASCAN ;S can ERA
  421    N AMT,ERA IEN,FDATE, PNAME,REC0 ,SUB,STATU S,TRACE 
  422    ;Scan for  unmatched  ERA
  423    S ERAIEN= 0,STATUS=0 ,SUB="ERA"
  424    F  S ERAI EN=$O(^RCY (344.4,"AM ATCH",STAT US,ERAIEN) ) Q:'ERAIE N  D
  425    .S REC0=$ G(^RCY(344 .4,ERAIEN, 0))
  426    .;Get ERA  file date /time
  427    .S FDATE= $P(REC0,U, 7) Q:'FDAT E
  428    .;Ignore  if <31 day s overdue
  429    .Q:$$FMDI FF^XLFDT(T ODAY,FDATE ,1)<31
  430    .;Trace,  Payer Name  and Amoun t
  431    .S PNAME= $P(REC0,U, 6),AMT=$P( REC0,U,5), TRACE=$P(R EC0,U,2)
  432    .I $L(PNA ME)>35 S P NAME=$E(PN AME,1,35)  ; limit si ze of the  name
  433    .;Update  count and  totals
  434    .S ERACNT =ERACNT+1, ERATOT=ERA TOT+AMT
  435    . ; PRCA* 4.5*303 ad ded the FD ATE subscr ipt to the  global so  that the  line
  436    . ; items  collate i n date asc ending ord er.
  437    . ;Save E RA#, Payer  Name, Fil e Date, Tr ace# and A mount Paid
  438    .S ^TMP(R CPROG,$J," ERA",FDATE ,ERACNT)=$ $ERAL(ERAI EN,PNAME,F DATE,AMT)
  439    .S ^TMP(R CPROG,$J," ERA",FDATE ,ERACNT,”T R”)=”   “_ TRACE  
  440    ;
  441    ;Scan for  Matched/U nposted ER A
  442    S SUB="ER A1"
  443    F STATUS= -1,1,2,3 D
  444    . S ERAIE N=0 F  S E RAIEN=$O(^ RCY(344.4, "AMATCH",S TATUS,ERAI EN)) Q:'ER AIEN  D
  445    .. S REC0 =$G(^RCY(3 44.4,ERAIE N,0))
  446    .. ;Get E RA file da te/time
  447    .. S FDAT E=$P(REC0, U,7) Q:'FD ATE
  448    .. ;Ignor e if <31 d ays overdu e
  449    .. Q:$$FM DIFF^XLFDT (TODAY,FDA TE,1)<31
  450    .. ;Ignor e if not u nposted po sted
  451    .. Q:$P($ G(^RCY(344 .4,ERAIEN, 0)),U,14)> 0
  452    .. ;Payer  Name, Tra ce and Amo unt
  453    .. S PNAM E=$P(REC0, U,6),AMT=$ P(REC0,U,5 ),TRACE=$P (REC0,U,2)
  454    .. I $L(P NAME)>35 S  PNAME=$E( PNAME,1,35 ) ; limit  size of th e name
  455    .. ; PRCA *4.5*303 S plit into  "ACH" and  not "ACH"
  456    .. ;Updat e count an d totals
  457    .. S:$P(R EC0,U,15)= "ACH" ERA1 CNT=ERA1CN T+1,ERA1TO T=ERA1TOT+ AMT
  458    .. S:$P(R EC0,U,15)' ="ACH" ERA 2CNT=ERA2C NT+1,ERA2T OT=ERA2TOT +AMT
  459    .. ;PRCA* 4.5*303 ad ded the FD ATE subscr ipt to the  global so  that the  line
  460    .. ;items  collate i n date asc ending ord er.
  461    .. ;Save  ERA#, Paye r Name, Fi le Date, T race# and  Amount Pai d
  462    .. I $P(R EC0,U,15)= "ACH" D   
  463    ... S ^TM P(RCPROG,$ J,"ERA1",F DATE,ERA1C NT)=$$ERAL (ERAIEN,PN AME,FDATE, AMT)
  464    ... S ^TM P(RCPROG,$ J,"ERA1",F DATE,ERA1C NT,”TR”)=”    “_TRACE   
  465    ..I $P(RE C0,U,15)'= "ACH" D
  466    ... S ^TM P(RCPROG,$ J,"ERA2",F DATE,ERA2C NT)=$$ERAL (ERAIEN,PN AME,FDATE, AMT)
  467    ... S ^TM P(RCPROG,$ J,"ERA2",F DATE,ERA2C NT,”TR”)=”    “_TRACE   
  468    .. Q
  469    . Q
  470    Q
  471    ;
  472   EFTSCAN ;S can EFT
  473    N DEPN,EF TIEN,IEN34 43,EFTDATE ,TRACE,REC 0,REC31,RE C4,STATUS, PAYER,DEPA MT
  474    ;Scan for  unmatched  EFT
  475    S EFTIEN= 0,STATUS=0
  476    ; PRCA*4. 5*303 Chec k all stat uses repor t on unmat ched EFTs,  Matched E FTs with u nposted ER As
  477    ; 4-7-201 6 Removed  F STATUS=- 1,0,1 per  issue iden tifying du plicate EF Ts this wi ll need to  be
  478    ; address ed in anot her projec t
  479    S STATUS= 0 F  S EFT IEN=$O(^RC Y(344.31," AMATCH",ST ATUS,EFTIE N)) Q:'EFT IEN  D
  480    .S REC31= $G(^RCY(34 4.31,EFTIE N,0))
  481    .;PRCA*4. 5*303 Get  zero node  of the ass ociated ER A if match ed
  482    .S REC4=$ S($P(REC31 ,U,10)'="" :$G(^RCY(3 44.4,$P(RE C31,U,10), 0)),1:"")
  483    .;Get poi nter to EF T file
  484    .S IEN344 3=$P(REC31 ,U) Q:'IEN 3443
  485    .S REC0=$ G(^RCY(344 .3,IEN3443 ,0))
  486    .;Get EFT  file date
  487    .S EFTDAT E=$P(REC0, U,2) Q:'EF TDATE
  488    .;Ignore  if <15 day s overdue
  489    .Q:$$FMDI FF^XLFDT(T ODAY,EFTDA TE,1)<15
  490    .;PRCA*4. 5*303 - if  we have a  ERA check  to see if  we includ e this rec ord or qui t
  491    .I REC4'= "" Q:$P(RE C4,U,14)'= 0 ; Not po sted statu s is 0 - e verything  else is ig nored
  492    .;Deposit  number an d payment  amount
  493    .S DEPN=$ P(REC0,U,6 ),DEPAMT=$ P(REC31,U, 7)
  494    .;Payer I D and Trac e from EFT  detail fi le
  495    .S PAYER= $P(REC31,U ,2),TRACE= $P(REC31,U ,4) S:PAYE R="" PAYER ="NO PAYER  NAME RECE IVED" ; PR CA*4.5*298
  496    .;If paye r and trac e combined  are >40 t runcate pa yer name f irst
  497    .I $L(PAY ER_TRACE)> 40 D
  498    ..I $L(PA YER)>20 S  PAYER=$E(P AYER,1,20)  ; limit s ize of the  name
  499    ..Q:$L(PA YER_TRACE) <41
  500    ..S TRACE =$E(TRACE, 1,20) ; li mit size o f the trac e
  501    .;Update  count and  totals
  502    .S EFTCNT =EFTCNT+1, EFTTOT=EFT TOT+DEPAMT
  503    .; PRCA*4 .5*303 add ed EFTDATE  to the su bscripts b efore EFTC NT so repo rt will so rt in
  504    .; date a scending o rder.
  505    .;Save De posit No,  Receipt, P ayer ID, E FT Date an d Deposit  Amount
  506    .S ^TMP(R CPROG,$J," EFT",EFTDA TE,EFTCNT) =$$EFTL(DE PN,TRACE,P AYER,EFTDA TE,DEPAMT)
  507    Q
  508    ;
  509    ; PRCA*4. 5*304
  510    ; Scan fo r ERA's ol der than a llowed by  parameter
  511   SUSPSCAN ;
  512    N RCCT,RC DATA,RCSDA TE,RCDATA0 ,RCDATA2,R CDATA3,RCM AXDAY,RCRE CTDA,RCTRA NDA
  513    N RCDEP,R CTRACE,RCP AYER,RCEFT DT,RCDEPAM T,RCDAYS,R CUSER,RCRE C,RCDISP,R CRSN,RCSRE C
  514    ;
  515    ;initiali ze counter s
  516    S (RCSUSA MT,RCSUSCN T)=0
  517    ;
  518    ;calculat e the last  date to s top gather ing entrie s on
  519    S RCMAXDA Y=TODAY-RC MXDYS
  520    ;
  521    ;Loop thr ough the I n Suspense  index
  522    S (RCRECT DA,RCCT)=0
  523    F  S RCRE CTDA=$O(^R CY(344,"AN ",RCRECTDA )) Q:'RCRE CTDA  D
  524    . S RCDAT A=$G(^RCY( 344,RCRECT DA,0))
  525    . S RCREC =$P(RCDATA ,U)
  526    . S RCTRA NDA=0 F  S  RCTRANDA= $O(^RCY(34 4,"AN",RCR ECTDA,RCTR ANDA)) Q:' RCTRANDA   D
  527    . . S RCD ATA0=$G(^R CY(344,RCR ECTDA,1,RC TRANDA,0))
  528    . . S RCD ATA2=$G(^R CY(344,RCR ECTDA,1,RC TRANDA,2))
  529    . . S RCD ATA3=$G(^R CY(344,RCR ECTDA,1,RC TRANDA,3))
  530    . . ;get  date into  suspense
  531    . . S RCS DATE=$P(RC DATA3,U,2)
  532    . . S RCD AYS=$$FMTH ^XLFDT(TOD AY,1)-$$FM TH^XLFDT(R CSDATE,1)
  533    . . Q:RCS DATE=""
  534    . . ;
  535    . . ;if y ounger tha n the cuto ff date, q uit
  536    . . Q:RCD AYS'>RCMXD YS
  537    . . ;
  538    . . ; get  the user  and dispos ition
  539    . . S RCU SER=$$GET1 ^DIQ(200,$ P(RCDATA3, U,3)_",",1 ,"E")
  540    . . S RCD ISP=$$UP^X LFSTR($$GE T1^DIQ(344 .01,RCTRAN DA_","_RCR ECTDA_",", 3.01))
  541    . . ;
  542    . . ;Susp ense statu s has been  cleared q uit
  543    . . Q:$P( RCDATA2,U, 6)'="" 
  544    . . ;
  545    . . ;Extr act needed  info for  report
  546    . . S RCE FTDT=$P(RC DATA0,U,6) ,RCDEPAMT= $P(RCDATA0 ,U,4)
  547    . . ;
  548    . . ;upda te counter  and amoun t info
  549    . . S RCS USCNT=RCSU SCNT+1
  550    . . S RCS USAMT=RCSU SAMT+RCDEP AMT
  551    . . S RCR SN=$E($P($ G(^RCY(344 ,RCRECTDA, 1,RCTRANDA ,1)),U,2), 1,12)
  552    . . S RCS REC=RCREC_ "@"_RCTRAN DA
  553    . . ;
  554    . . ;upda te tempora ry array
  555    . . S ^TM P(RCPROG,$ J,"SUSPENS E",RCSDATE ,RCSUSCNT) =$$ESUSPL( RCSDATE,RC DAYS,RCUSE R,RCSREC,R CDEPAMT,RC DISP,RCRSN )
  556    ;
  557    Q
  558    ;
  559   BULLETIN ; Create bul letins onl y if overd ue EFT/ERA  found
  560    ;
  561    N ARRAY,S BJ,SUB,CNT ,CNT1,RCPR OG1,GLB,RC MXDYS,IDX
  562    S RCPROG1 ="RCDPEM7A ",GLB=$NA( ^TMP(RCPRO G1,$J,"XMT EXT"))
  563    ;
  564    ;Unmatche d ERA bull etins
  565    I ERACNT  D
  566    .;Build h eader
  567    .S SUB="E RA" K @GLB
  568    .S SBJ="E DI LBOX-ST A# "_$P($$ SITE^VASIT E,"^",3)_" -ACTION RE Q-Unmatche d ERAs > 3 0 days"
  569    .S @GLB@( 1)="The li sted ERAs  were recei ved more t han 30 day s ago and  have not y et been"
  570    .S @GLB@( 2)="matche d."
  571    .S @GLB@( 3)=" "
  572    .S @GLB@( 4)="Total  # of ERAs  - "_ERACNT
  573    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(ERAT OT,",",2)
  574    .S @GLB@( 6)=" "
  575    .S @GLB@( 7)="ERA# P AYER NAME  FILE DATE  AMOUNT PAI D"
  576    .S @GLB@( 8)="   TRA CE#"
  577    .;
  578    .;Move un matched ER A search f indings in to message
  579    .S CNT=0, CNT1=9,SUB ="ERA"
  580    .S IDX=""  F  S IDX= $O(^TMP(RC PROG,$J,SU B,IDX)) Q: 'IDX  F  S  CNT=$O(^T MP(RCPROG, $J,SUB,IDX ,CNT)) Q:' CNT  D
  581    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT)
  582    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT,”TR” )
  583    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  584    .D SEND
  585    .K @GLB
  586    ;
  587    ;Unposted  "ACH" ERA  bulletins
  588    ; PRCA*4. 5*303 - mo dified thi s bulletin  to show o nly "ACH"  expected p ayments
  589    I ERA1CNT  D
  590    .;Build h eader
  591    .S SUB="E RA1" K @GL B
  592    .; PRCA*4 .5*303 - C hanged SBJ  to make s ure it was  less than  65 charac ters
  593    .S SBJ="E DI LBOX-ST A# "_$P($$ SITE^VASIT E,"^",3)_" -ACTION RE Q-EFT:Matc hed/Not Po sted ERA>3 0 days"
  594    .S @GLB@( 1)="The li sted ERAs  were recei ved more t han 30 day s ago and  have been  matched bu t"
  595    .S @GLB@( 2)="have n ot been po sted"
  596    .S @GLB@( 3)=" "
  597    .S @GLB@( 4)="Total  # of ERAs  - ""MATCHE D TO EFT""  - "_ERA1C NT
  598    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(ERA1 TOT,",",2)
  599    .S @GLB@( 6)=" "
  600    .S @GLB@( 7)="ERA# P AYER NAME  FILE DATE  AMOUNT PAI D"
  601    .S @GLB@( 8)="   TRA CE#"
  602    .;
  603    .;Move un posted ERA  search fi ndings int o message
  604    .S CNT=0, CNT1=9,IDX =""
  605    .F  S IDX =$O(^TMP(R CPROG,$J,S UB,IDX)) Q :'IDX  F   S CNT=$O(^ TMP(RCPROG ,$J,SUB,ID X,CNT)) Q: 'CNT  D
  606    ..S CNT1= CNT1+1
  607    ..S @GLB@ (CNT1)=^TM P(RCPROG,$ J,SUB,IDX, CNT)
  608    ..S CNT1= CNT1+1
  609    ..S @GLB@ (CNT1)=^TM P(RCPROG,$ J,SUB,IDX, CNT,”TR”)
  610    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  611    .D SEND
  612    .K @GLB
  613    ;
  614    ;Unposted  "CHK" ERA  bulletins  or ERAs,  that don't  match "AC H"
  615    ; PRCA*4. 5*303 - mo dified thi s bulletin  to show " CHK" expec ted paymen ts (or don 't match " ACH")
  616    I ERA2CNT  D
  617    .;Build h eader
  618    .S SUB="E RA2" K @GL B
  619    .; PRCA*4 .5*303 - C hanged SBJ  to make s ure it was  less than  65 charac ters
  620    .S SBJ="E DI LBOX-ST A# "_$P($$ SITE^VASIT E,"^",3)_" -ACTION RE Q-PAPER:Ma tched/Not  Posted ERA >30 days"
  621    .S @GLB@( 1)="The li sted ERAs  were recei ved more t han 30 day s ago and  have been  matched bu t"
  622    .S @GLB@( 2)="have n ot been po sted"
  623    .S @GLB@( 3)=" "
  624    .S @GLB@( 4)="Total  # of ERAs  - ""MATCHE D TO PAPER  CHECK"" -  "_ERA2CNT
  625    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(ERA2 TOT,",",2)
  626    .S @GLB@( 6)=" "
  627    .S @GLB@( 7)="ERA# P AYER NAME  FILE DATE  AMOUNT PAI D"
  628    .S @GLB@( 8)="   TRA CE#"
  629    .;
  630    .;Move un posted ERA  search fi ndings int o message
  631    .S CNT=0, CNT1=9,IDX =""
  632    .F  S IDX =$O(^TMP(R CPROG,$J,S UB,IDX)) Q :'IDX  F   S CNT=$O(^ TMP(RCPROG ,$J,SUB,ID X,CNT)) Q: 'CNT  D
  633    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT)
  634    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT,”TR” )
  635    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  636    .D SEND
  637    .K @GLB
  638    ;
  639    ;Unmatche d EFT bull etins
  640    ; PRCA*4. 5*303 - Ch anged logi c to send  "No EFTs m ore than 1 4 days..."  message i f no EFTs
  641    ;I EFTCNT  D
  642    ;Build he ader
  643    S SUB="EF T" K @GLB
  644    S SBJ="ED I LBOX-STA # "_$P($$S ITE^VASITE ,"^",3)_"- ACTION REQ -EFTs > 14  days"
  645    I EFTCNT= 0 D  G B1
  646    . S @GLB@ (1)="****  There are  NO EFTs mo re than 14  days old  that have  not yet be en matched ."
  647    . S @GLB@ (2)=" "
  648    . S @GLB@ (3)="Total  # of EFTs  - "_EFTCN T
  649    . S @GLB@ (4)="Total  Dollar Am ount - $"_ $FN(0,",", 2)
  650    . S @GLB@ (5)=" "
  651    . S @GLB@ (6)="** EN D OF REPOR T **"
  652    ;
  653    I EFTCNT> 0 D
  654    .S @GLB@( 1)="The fo llowing EF Ts were re ceived mor e than 14  days ago a nd have no t yet"
  655    .S @GLB@( 2)="been m atched."
  656    .S @GLB@( 3)=" "
  657    .S @GLB@( 4)="Total  # of EFTs  - "_EFTCNT
  658    .S @GLB@( 5)="Total  Dollar Amo unt - "_"$ "_$FN(EFTT OT,",",2)
  659    .S @GLB@( 6)=" "
  660    .S @GLB@( 7)="DEPOSI T# PAYER N AME/TRACE#  EFT DATE  DEPOSIT AM T"
  661    .;
  662    .;Move EF T search f indings in to message
  663    .S CNT=0, CNT1=8,SUB ="EFT",IDX =""
  664    .F  S IDX =$O(^TMP(R CPROG,$J,S UB,IDX)) Q :'IDX  F   S CNT=$O(^ TMP(RCPROG ,$J,SUB,ID X,CNT)) Q: 'CNT  D
  665    ..S CNT1= CNT1+1,@GL B@(CNT1)=^ TMP(RCPROG ,$J,SUB,ID X,CNT)
  666    .S @GLB@( CNT1+1)="* * END OF R EPORT **"
  667   B1 ;
  668    D SEND
  669    K @GLB
  670    ;
  671    ;PRCA*4.5 *304 - Add  suspense  bulletin
  672    ; Suspens e bulletin s
  673    ;
  674    ; Send bu lletin if  items in s uspense
  675    I RCSUSCN T D
  676    . ;
  677    . N DT
  678    . ;Retrie ve the par ameter
  679    . S RCMXD YS=$$GET1^ DIQ(342,"1 ,",7.04)
  680    . ;
  681    . ;Build  header
  682    . S SUB=" SUSPENSE"  K @GLB
  683    . S SBJ=" EDI LBOX-S TA# "_$P($ $SITE^VASI TE,"^",3)_ "-SUSPENSE  ENTRIES O VERDUE FOR  PROCESSIN G"
  684    . S @GLB@ (1)="The f ollowing e ntries hav e been in  Suspense p ast the #d ays allowe d by site"
  685    . S @GLB@ (2)="param eter - whi ch is curr ently set  at "_RCMXD YS_" days. "
  686    . S @GLB@ (3)=" "
  687    . S @GLB@ (4)="Total  # of Over due Entrie s in Suspe nse - "_RC SUSCNT
  688    . S @GLB@ (5)="Total  Dollar Am ount Overd ue in Susp ense - "_" $"_$FN(RCS USAMT,",", 2)
  689    . S @GLB@ (6)=" "
  690    . S @GLB@ (7)="SUSP  DATE #DAYS  USER RECE IPT# AMOUN T DISP REA SON"
  691    . ;
  692    . ;Move S uspense se arch findi ngs into m essage
  693    . S CNT=0 ,CNT1=8,SU B="SUSPENS E",DT=0
  694    . F  S DT =$O(^TMP(R CPROG,$J,S UB,DT)) Q: 'DT  D
  695    . . F  S  CNT=$O(^TM P(RCPROG,$ J,SUB,DT,C NT)) Q:'CN T  D
  696    . . . S C NT1=CNT1+1 ,@GLB@(CNT 1)=^TMP(RC PROG,$J,SU B,DT,CNT)
  697    . S @GLB@ (CNT1+1)=" ** END OF  REPORT **"
  698    . D SEND
  699    . K @GLB
  700    Q
  701    ;
  702   SEND ;Tran smit mail  message
  703    N XMDUZ,X MTEXT,XMSU B,XMY,XMIN STR
  704    S XMDUZ=D UZ,XMTEXT= GLB,XMSUB= SBJ,XMY("I :G.RCDPE A UDIT")=""
  705    S XMINSTR ("FROM")=" POSTMASTER "
  706    S XMINSTR ("FLAGS")= "P"
  707    D SENDMSG ^XMXAPI(XM DUZ,XMSUB, XMTEXT,.XM Y,.XMINSTR )
  708    Q
  709    ;
  710   ERAL(X1,X2 ,X3,X4) ;F ormat ERA  Message li ne
  711    N SPACE
  712    S SPACE=$ J("",80)
  713    S X1=X1_$ E(SPACE,1, 12-$L(X1))
  714    S X2=X1_$ E(X2,1,43) _$E(SPACE, 1,43-$L(X2 ))
  715    S X3=$$FM TE^XLFDT(X 3,"2D")
  716    S X4="$"_ $FN(X4,"," ,2)
  717    Q X2_$J(X 3,8)_$J(X4 ,15)
  718    ;
  719   EFTL(X1,X2 ,X3,X4,X5)  ;Format E FT Message  line
  720    N SPACE
  721    S SPACE=$ J("",80)
  722    S X1=X1_$ E(SPACE,1, 10-$L(X1)) _" "
  723    S X2=X3_" /"_X2 ;Pay er and Tra ce
  724    S X2=X1_$ E(X2,1,41) _$E(SPACE, 1,42-$L(X2 ))
  725    S X4=$$FM TE^XLFDT(X 4,"2D")
  726    S X5="$"_ $FN(X5,"," ,2)
  727    Q X2_$J(X 4,8)_$J(X5 ,15)
  728    ;
  729    ;PRCA*4.5 *304
  730   ESUSPL(X1, X2,X3,X4,X 5,X6,X7) ; Format Sus pense Mess age line
  731    N SPACE
  732    S SPACE=$ J("",80)
  733    ;spacing  for Suspen se Date
  734    S X1=$$FM TE^XLFDT(X 1,"2D")
  735    S X1=X1_$ E(SPACE,1, 10-$L(X1))
  736    ;spacing  for # days  in suspen se
  737    S X2=$E(S PACE,1,6-$ L(X2))_X2
  738    ;spacing  for USER
  739    S X3=" "_ X3_$E(SPAC E,1,5-$L(X 3))
  740    ;spacing  for RECEIP T NUMBER_T RANS #
  741    S X4=$E(X 4_SPACE,1, 16)
  742    ;spacing  for amount  in suspen se
  743    S X5=$J(" $"_$FN(X5, ",",2),13) _" "
  744    ;spacing  for STATUS
  745    S X6=X6_$ E(SPACE,1, 12-$L(X6))
  746    ;spacing  for REASON
  747    S X7=X7_$ E(SPACE,1, 12-$L(X7))
  748    ;return c oncatenate d string
  749    Q X1_X2_X 3_X4_X5_X6 _X7
  750    ;