- 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 Feb 18, 2025@23:13:39 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