RCP321 ;BIRM/EWL ALB/PJH - ePayment Lockbox Post-Installation Processing ;Dec 20, 2014@14:08:45
;;4.5;Accounts Receivable;**321**;Jan 21, 2014;Build 48
;Per VA Directive 6402, this routine should not be modified.
Q
;
POST() ; Task jobs to initialize RCDPE COMMENT HISTORY file #344.73
;
N DIK,ERR,K34461,RCENT,RCERR,RCINST,RCOUT,RCPAR,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
; set ^XTMP zero node for 180 day retention
S ^XTMP($T(+0),0)=$$HTFM^XLFDT($H+180)_U_DT_"^PRCA*4.5*321 post-installation"
D BMES^XPDUTL("Post-installation tasks "_$$FMTE^XLFDT($$NOW^XLFDT)) ; add date/time to log
D BMES^XPDUTL("Queueing task to initialize RCDPE COMMENT HISTORY file #344.73")
S ZTRTN="INIT1^"_$T(+0),ZTDESC="RCDPE COMMENT HISTORY (#344.73) post-init work",ZTIO="",ZTDTH=$H
D ^%ZTLOAD
D MES^XPDUTL($S($G(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task."))
I $G(ZTSK) D MES^XPDUTL("A MailMan message will be sent on completion.")
;
D BMES^XPDUTL("Deleting old style 'B' index on file (#344.6)")
D DELIX^DDMOD(344.6,.01,1,"K")
D BMES^XPDUTL("Re-indexing PAYER NAME on AUTO-PAY EXCLUSION file (#344.6)")
S DIK="^RCY(344.6,",DIK(1)=".01^B" D ENALL^DIK
D BMES^XPDUTL("Re-indexing DATE OPENED on AR BATCH PAYMENTS file (#344)")
S DIK="^RCY(344,",DIK(1)=".03^AO" D ENALL^DIK
;
; RCDPE AUDIT mail group update
N RCAUD,RCRMEM,Z
D MES^XPDUTL("Updating RCDPE AUDIT mail group.")
; Integration Agreement 6814 for access to ^XMB(3.8
S RCAUD=$$FIND1^DIC(3.8,"","MX","RCDPE AUDIT","","","ERR") Q:'RCAUD
; Delete any REMOTE MEMBER containing text of VHA835NOTIFY (upper or lower case)
S Z=0
F S Z=$O(^XMB(3.8,RCAUD,6,Z)) Q:'Z D
. S RCRMEM=$$GET1^DIQ(3.812,Z_","_RCAUD_",",.01)
. Q:$$UP^XLFSTR(RCRMEM)'["VHA835NOTIFY"
. N DA,DIK
. S DA(1)=RCAUD,DA=Z,DIK="^XMB(3.8,"_DA(1)_",6,"
. D ^DIK
. D MES^XPDUTL("Removed REMOTE MEMBER = "_RCRMEM)
;
; If empty populate parameter DAY TO SEND WORKLOAD NOTIFICATIONS with SATURDAY
D:$$GET1^DIQ(344.61,"1,",.1)=""
.N DA,DIE,DR
.S DIE="^RCY(344.61,",DR=".1///SA;",DA=1 D ^DIE
;
; Decrease Medical and Pharmacy EFT prevent days if they exceed the new maximum
S K34461=0
F S K34461=$O(^RCY(344.61,K34461)) Q:'K34461 D
. N MEPREV,RXPREV
. S MEPREV=$$GET1^DIQ(344.61,K34461_",",.06,"I")
. I MEPREV>60 D ;
. . N FDA
. . S FDA(344.61,K34461_",",.06)=60
. . D FILE^DIE("","FDA")
. ;
. S RXPREV=$$GET1^DIQ(344.61,K34461_",",.07,"I")
. I RXPREV>365 D ;
. . N FDA
. . S FDA(344.61,K34461_",",.07)=365
. . D FILE^DIE("","FDA")
;
US795 ; Convert default for ERA_CLAIM_TYPE in worklist from "B" to "A"
K ^TMP($J,"RCP321")
S RCOUT="^TMP($J,""RCP321"")"
S RCPAR="RCDPE EDI LOCKBOX WORKLIST"
S RCINST="ERA_CLAIM_TYPE"
D ENVAL^XPAR(.RCOUT,RCPAR,RCINST,.RCERR,1) ; IA 2992 PARAMETER DEFINITION TOOLKIT
S RCENT=""
F S RCENT=$O(^TMP($J,"RCP321",RCENT)) Q:RCENT="" D ;
. I $G(^TMP($J,"RCP321",RCENT,RCINST))="B" D ;
. . D EN^XPAR(RCENT,RCPAR,RCINST,"A",.RCERR) ; IA 2992 PARAMETER DEFINITION TOOLKIT
;
Q
;
INIT1 ;Build 344.73
; Clear any existing history
D PURGE
;
N COMMENT,DATE,RCNODE,RCBODY,RCSUBJ,RCTO,RCLINE,RCRCPT,RCSUSP,RCZR,USER,XMINSTR
S RCNODE("BEG")=$$NOW^XLFDT,RCNODE("CNT")=0
S ^XTMP($T(+0),"BEGIN")=RCNODE("BEG")
;Scan receipt file for suspense comments
S RCRCPT=0
F S RCRCPT=$O(^RCY(344,RCRCPT)) Q:'RCRCPT D
. S RCLINE=0
. F S RCLINE=$O(^RCY(344,RCRCPT,1,RCLINE)) Q:'RCLINE D
.. ; Check that line is still in suspense
.. S RCSUSP=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.01) Q:RCSUSP=""
.. ; Receipt line comment
.. S COMMENT=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",1.02) Q:$L(COMMENT)<3
.. ; Date placed into suspense
.. S DATE=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.02,"I") Q:DATE=""
.. ; Placed into suspense by
.. S USER=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.03,"I") Q:USER=""
.. N FDA,ERR
.. S FDA(344.73,"+1,",.01)=RCRCPT ;Receipt
.. S FDA(344.73,"+1,",1)=RCLINE ;Scratchpad or Receipt Line Number
.. S FDA(344.73,"+1,",2)=USER ;User
.. S FDA(344.73,"+1,",3)=DATE ;Date/time ;
.. S FDA(344.73,"+1,",4)=COMMENT ;Comment ;file entry
.. D UPDATE^DIE(,"FDA","ERR")
.. S RCNODE("CNT")=RCNODE("CNT")+1
;
S RCNODE("END")=$$NOW^XLFDT
S ^XTMP($T(+0),"FINISHED")=RCNODE("END")
; create MailMan message text
S RCBODY(0)=0
D ADD2TXT(.RCBODY,"Finished RCDPE COMMENT HISTORY file #344.73 initialization task.")
D ADD2TXT(.RCBODY," Process begun: "_$$FMTE^XLFDT(RCNODE("BEG")))
D ADD2TXT(.RCBODY," Process ended: "_$$FMTE^XLFDT(RCNODE("END")))
D ADD2TXT(.RCBODY," Comment count: "_$$FMTE^XLFDT(RCNODE("CNT")))
D ADD2TXT(.RCBODY,"Report generated by the "_$T(+0)_" post-initialization routine.")
;
; save MailMan message text
M ^XTMP($T(+0),"MAIL MSG",$$NOW^XLFDT)=RCBODY
; send via MailMan
S RCSUBJ="PRCA*4.5*321 Post Install Routine Completed"
S RCTO(.5)="",RCTO(DUZ)="" ; POSTMASTER and user who queued it
S RCTO("G.RCDPE PAYMENTS MGMT")=""
S XMINSTR("FROM")="POSTMASTER"
;
D SENDMSG^XMXAPI(DUZ,RCSUBJ,"RCBODY",.RCTO,.XMINSTR,.RCZR) ; send message
Q
;
ADD2TXT(TXARY,LN) ; add LN to TXARY for MailMan Message
; TXARY passed by ref.
I $G(LN)'="" S TXARY(0)=$G(TXARY(0))+1,TXARY(TXARY(0),0)=LN
Q
;
PURGE ; Clear any existing history
N DA,DIK,RCPURGE,SUB
S SUB=0
F S SUB=$O(^RCY(344.73,SUB)) Q:'SUB D
.S DIK="^RCY(344.73,",DA=SUB D ^DIK
K ^XTMP($T(+0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCP321 5490 printed Apr 09, 2024@20:55:05 Page 2
RCP321 ;BIRM/EWL ALB/PJH - ePayment Lockbox Post-Installation Processing ;Dec 20, 2014@14:08:45
+1 ;;4.5;Accounts Receivable;**321**;Jan 21, 2014;Build 48
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POST() ; Task jobs to initialize RCDPE COMMENT HISTORY file #344.73
+1 ;
+2 NEW DIK,ERR,K34461,RCENT,RCERR,RCINST,RCOUT,RCPAR,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+3 ; set ^XTMP zero node for 180 day retention
+4 SET ^XTMP($TEXT(+0),0)=$$HTFM^XLFDT($HOROLOG+180)_U_DT_"^PRCA*4.5*321 post-installation"
+5 ; add date/time to log
DO BMES^XPDUTL("Post-installation tasks "_$$FMTE^XLFDT($$NOW^XLFDT))
+6 DO BMES^XPDUTL("Queueing task to initialize RCDPE COMMENT HISTORY file #344.73")
+7 SET ZTRTN="INIT1^"_$TEXT(+0)
SET ZTDESC="RCDPE COMMENT HISTORY (#344.73) post-init work"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+8 DO ^%ZTLOAD
+9 DO MES^XPDUTL($SELECT($GET(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task."))
+10 IF $GET(ZTSK)
DO MES^XPDUTL("A MailMan message will be sent on completion.")
+11 ;
+12 DO BMES^XPDUTL("Deleting old style 'B' index on file (#344.6)")
+13 DO DELIX^DDMOD(344.6,.01,1,"K")
+14 DO BMES^XPDUTL("Re-indexing PAYER NAME on AUTO-PAY EXCLUSION file (#344.6)")
+15 SET DIK="^RCY(344.6,"
SET DIK(1)=".01^B"
DO ENALL^DIK
+16 DO BMES^XPDUTL("Re-indexing DATE OPENED on AR BATCH PAYMENTS file (#344)")
+17 SET DIK="^RCY(344,"
SET DIK(1)=".03^AO"
DO ENALL^DIK
+18 ;
+19 ; RCDPE AUDIT mail group update
+20 NEW RCAUD,RCRMEM,Z
+21 DO MES^XPDUTL("Updating RCDPE AUDIT mail group.")
+22 ; Integration Agreement 6814 for access to ^XMB(3.8
+23 SET RCAUD=$$FIND1^DIC(3.8,"","MX","RCDPE AUDIT","","","ERR")
if 'RCAUD
QUIT
+24 ; Delete any REMOTE MEMBER containing text of VHA835NOTIFY (upper or lower case)
+25 SET Z=0
+26 FOR
SET Z=$ORDER(^XMB(3.8,RCAUD,6,Z))
if 'Z
QUIT
Begin DoDot:1
+27 SET RCRMEM=$$GET1^DIQ(3.812,Z_","_RCAUD_",",.01)
+28 if $$UP^XLFSTR(RCRMEM)'["VHA835NOTIFY"
QUIT
+29 NEW DA,DIK
+30 SET DA(1)=RCAUD
SET DA=Z
SET DIK="^XMB(3.8,"_DA(1)_",6,"
+31 DO ^DIK
+32 DO MES^XPDUTL("Removed REMOTE MEMBER = "_RCRMEM)
End DoDot:1
+33 ;
+34 ; If empty populate parameter DAY TO SEND WORKLOAD NOTIFICATIONS with SATURDAY
+35 if $$GET1^DIQ(344.61,"1,",.1)=""
Begin DoDot:1
+36 NEW DA,DIE,DR
+37 SET DIE="^RCY(344.61,"
SET DR=".1///SA;"
SET DA=1
DO ^DIE
End DoDot:1
+38 ;
+39 ; Decrease Medical and Pharmacy EFT prevent days if they exceed the new maximum
+40 SET K34461=0
+41 FOR
SET K34461=$ORDER(^RCY(344.61,K34461))
if 'K34461
QUIT
Begin DoDot:1
+42 NEW MEPREV,RXPREV
+43 SET MEPREV=$$GET1^DIQ(344.61,K34461_",",.06,"I")
+44 ;
IF MEPREV>60
Begin DoDot:2
+45 NEW FDA
+46 SET FDA(344.61,K34461_",",.06)=60
+47 DO FILE^DIE("","FDA")
End DoDot:2
+48 ;
+49 SET RXPREV=$$GET1^DIQ(344.61,K34461_",",.07,"I")
+50 ;
IF RXPREV>365
Begin DoDot:2
+51 NEW FDA
+52 SET FDA(344.61,K34461_",",.07)=365
+53 DO FILE^DIE("","FDA")
End DoDot:2
End DoDot:1
+54 ;
US795 ; Convert default for ERA_CLAIM_TYPE in worklist from "B" to "A"
+1 KILL ^TMP($JOB,"RCP321")
+2 SET RCOUT="^TMP($J,""RCP321"")"
+3 SET RCPAR="RCDPE EDI LOCKBOX WORKLIST"
+4 SET RCINST="ERA_CLAIM_TYPE"
+5 ; IA 2992 PARAMETER DEFINITION TOOLKIT
DO ENVAL^XPAR(.RCOUT,RCPAR,RCINST,.RCERR,1)
+6 SET RCENT=""
+7 ;
FOR
SET RCENT=$ORDER(^TMP($JOB,"RCP321",RCENT))
if RCENT=""
QUIT
Begin DoDot:1
+8 ;
IF $GET(^TMP($JOB,"RCP321",RCENT,RCINST))="B"
Begin DoDot:2
+9 ; IA 2992 PARAMETER DEFINITION TOOLKIT
DO EN^XPAR(RCENT,RCPAR,RCINST,"A",.RCERR)
End DoDot:2
End DoDot:1
+10 ;
+11 QUIT
+12 ;
INIT1 ;Build 344.73
+1 ; Clear any existing history
+2 DO PURGE
+3 ;
+4 NEW COMMENT,DATE,RCNODE,RCBODY,RCSUBJ,RCTO,RCLINE,RCRCPT,RCSUSP,RCZR,USER,XMINSTR
+5 SET RCNODE("BEG")=$$NOW^XLFDT
SET RCNODE("CNT")=0
+6 SET ^XTMP($TEXT(+0),"BEGIN")=RCNODE("BEG")
+7 ;Scan receipt file for suspense comments
+8 SET RCRCPT=0
+9 FOR
SET RCRCPT=$ORDER(^RCY(344,RCRCPT))
if 'RCRCPT
QUIT
Begin DoDot:1
+10 SET RCLINE=0
+11 FOR
SET RCLINE=$ORDER(^RCY(344,RCRCPT,1,RCLINE))
if 'RCLINE
QUIT
Begin DoDot:2
+12 ; Check that line is still in suspense
+13 SET RCSUSP=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.01)
if RCSUSP=""
QUIT
+14 ; Receipt line comment
+15 SET COMMENT=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",1.02)
if $LENGTH(COMMENT)<3
QUIT
+16 ; Date placed into suspense
+17 SET DATE=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.02,"I")
if DATE=""
QUIT
+18 ; Placed into suspense by
+19 SET USER=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.03,"I")
if USER=""
QUIT
+20 NEW FDA,ERR
+21 ;Receipt
SET FDA(344.73,"+1,",.01)=RCRCPT
+22 ;Scratchpad or Receipt Line Number
SET FDA(344.73,"+1,",1)=RCLINE
+23 ;User
SET FDA(344.73,"+1,",2)=USER
+24 ;Date/time ;
SET FDA(344.73,"+1,",3)=DATE
+25 ;Comment ;file entry
SET FDA(344.73,"+1,",4)=COMMENT
+26 DO UPDATE^DIE(,"FDA","ERR")
+27 SET RCNODE("CNT")=RCNODE("CNT")+1
End DoDot:2
End DoDot:1
+28 ;
+29 SET RCNODE("END")=$$NOW^XLFDT
+30 SET ^XTMP($TEXT(+0),"FINISHED")=RCNODE("END")
+31 ; create MailMan message text
+32 SET RCBODY(0)=0
+33 DO ADD2TXT(.RCBODY,"Finished RCDPE COMMENT HISTORY file #344.73 initialization task.")
+34 DO ADD2TXT(.RCBODY," Process begun: "_$$FMTE^XLFDT(RCNODE("BEG")))
+35 DO ADD2TXT(.RCBODY," Process ended: "_$$FMTE^XLFDT(RCNODE("END")))
+36 DO ADD2TXT(.RCBODY," Comment count: "_$$FMTE^XLFDT(RCNODE("CNT")))
+37 DO ADD2TXT(.RCBODY,"Report generated by the "_$TEXT(+0)_" post-initialization routine.")
+38 ;
+39 ; save MailMan message text
+40 MERGE ^XTMP($TEXT(+0),"MAIL MSG",$$NOW^XLFDT)=RCBODY
+41 ; send via MailMan
+42 SET RCSUBJ="PRCA*4.5*321 Post Install Routine Completed"
+43 ; POSTMASTER and user who queued it
SET RCTO(.5)=""
SET RCTO(DUZ)=""
+44 SET RCTO("G.RCDPE PAYMENTS MGMT")=""
+45 SET XMINSTR("FROM")="POSTMASTER"
+46 ;
+47 ; send message
DO SENDMSG^XMXAPI(DUZ,RCSUBJ,"RCBODY",.RCTO,.XMINSTR,.RCZR)
+48 QUIT
+49 ;
ADD2TXT(TXARY,LN) ; add LN to TXARY for MailMan Message
+1 ; TXARY passed by ref.
+2 IF $GET(LN)'=""
SET TXARY(0)=$GET(TXARY(0))+1
SET TXARY(TXARY(0),0)=LN
+3 QUIT
+4 ;
PURGE ; Clear any existing history
+1 NEW DA,DIK,RCPURGE,SUB
+2 SET SUB=0
+3 FOR
SET SUB=$ORDER(^RCY(344.73,SUB))
if 'SUB
QUIT
Begin DoDot:1
+4 SET DIK="^RCY(344.73,"
SET DA=SUB
DO ^DIK
End DoDot:1
+5 KILL ^XTMP($TEXT(+0))
+6 QUIT
