Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCP321

RCP321.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. POST() ; Task jobs to initialize RCDPE COMMENT HISTORY file #344.73
  1. ;
  1. N DIK,ERR,K34461,RCENT,RCERR,RCINST,RCOUT,RCPAR,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
  1. ; set ^XTMP zero node for 180 day retention
  1. S ^XTMP($T(+0),0)=$$HTFM^XLFDT($H+180)_U_DT_"^PRCA*4.5*321 post-installation"
  1. D BMES^XPDUTL("Post-installation tasks "_$$FMTE^XLFDT($$NOW^XLFDT)) ; add date/time to log
  1. D BMES^XPDUTL("Queueing task to initialize RCDPE COMMENT HISTORY file #344.73")
  1. S ZTRTN="INIT1^"_$T(+0),ZTDESC="RCDPE COMMENT HISTORY (#344.73) post-init work",ZTIO="",ZTDTH=$H
  1. D ^%ZTLOAD
  1. D MES^XPDUTL($S($G(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task."))
  1. I $G(ZTSK) D MES^XPDUTL("A MailMan message will be sent on completion.")
  1. ;
  1. D BMES^XPDUTL("Deleting old style 'B' index on file (#344.6)")
  1. D DELIX^DDMOD(344.6,.01,1,"K")
  1. D BMES^XPDUTL("Re-indexing PAYER NAME on AUTO-PAY EXCLUSION file (#344.6)")
  1. S DIK="^RCY(344.6,",DIK(1)=".01^B" D ENALL^DIK
  1. D BMES^XPDUTL("Re-indexing DATE OPENED on AR BATCH PAYMENTS file (#344)")
  1. S DIK="^RCY(344,",DIK(1)=".03^AO" D ENALL^DIK
  1. ;
  1. ; RCDPE AUDIT mail group update
  1. N RCAUD,RCRMEM,Z
  1. D MES^XPDUTL("Updating RCDPE AUDIT mail group.")
  1. ; Integration Agreement 6814 for access to ^XMB(3.8
  1. S RCAUD=$$FIND1^DIC(3.8,"","MX","RCDPE AUDIT","","","ERR") Q:'RCAUD
  1. ; Delete any REMOTE MEMBER containing text of VHA835NOTIFY (upper or lower case)
  1. S Z=0
  1. F S Z=$O(^XMB(3.8,RCAUD,6,Z)) Q:'Z D
  1. . S RCRMEM=$$GET1^DIQ(3.812,Z_","_RCAUD_",",.01)
  1. . Q:$$UP^XLFSTR(RCRMEM)'["VHA835NOTIFY"
  1. . N DA,DIK
  1. . S DA(1)=RCAUD,DA=Z,DIK="^XMB(3.8,"_DA(1)_",6,"
  1. . D ^DIK
  1. . D MES^XPDUTL("Removed REMOTE MEMBER = "_RCRMEM)
  1. ;
  1. ; If empty populate parameter DAY TO SEND WORKLOAD NOTIFICATIONS with SATURDAY
  1. D:$$GET1^DIQ(344.61,"1,",.1)=""
  1. .N DA,DIE,DR
  1. .S DIE="^RCY(344.61,",DR=".1///SA;",DA=1 D ^DIE
  1. ;
  1. ; Decrease Medical and Pharmacy EFT prevent days if they exceed the new maximum
  1. S K34461=0
  1. F S K34461=$O(^RCY(344.61,K34461)) Q:'K34461 D
  1. . N MEPREV,RXPREV
  1. . S MEPREV=$$GET1^DIQ(344.61,K34461_",",.06,"I")
  1. . I MEPREV>60 D ;
  1. . . N FDA
  1. . . S FDA(344.61,K34461_",",.06)=60
  1. . . D FILE^DIE("","FDA")
  1. . ;
  1. . S RXPREV=$$GET1^DIQ(344.61,K34461_",",.07,"I")
  1. . I RXPREV>365 D ;
  1. . . N FDA
  1. . . S FDA(344.61,K34461_",",.07)=365
  1. . . D FILE^DIE("","FDA")
  1. ;
  1. US795 ; Convert default for ERA_CLAIM_TYPE in worklist from "B" to "A"
  1. K ^TMP($J,"RCP321")
  1. S RCOUT="^TMP($J,""RCP321"")"
  1. S RCPAR="RCDPE EDI LOCKBOX WORKLIST"
  1. S RCINST="ERA_CLAIM_TYPE"
  1. D ENVAL^XPAR(.RCOUT,RCPAR,RCINST,.RCERR,1) ; IA 2992 PARAMETER DEFINITION TOOLKIT
  1. S RCENT=""
  1. F S RCENT=$O(^TMP($J,"RCP321",RCENT)) Q:RCENT="" D ;
  1. . I $G(^TMP($J,"RCP321",RCENT,RCINST))="B" D ;
  1. . . D EN^XPAR(RCENT,RCPAR,RCINST,"A",.RCERR) ; IA 2992 PARAMETER DEFINITION TOOLKIT
  1. ;
  1. Q
  1. ;
  1. INIT1 ;Build 344.73
  1. ; Clear any existing history
  1. D PURGE
  1. ;
  1. N COMMENT,DATE,RCNODE,RCBODY,RCSUBJ,RCTO,RCLINE,RCRCPT,RCSUSP,RCZR,USER,XMINSTR
  1. S RCNODE("BEG")=$$NOW^XLFDT,RCNODE("CNT")=0
  1. S ^XTMP($T(+0),"BEGIN")=RCNODE("BEG")
  1. ;Scan receipt file for suspense comments
  1. S RCRCPT=0
  1. F S RCRCPT=$O(^RCY(344,RCRCPT)) Q:'RCRCPT D
  1. . S RCLINE=0
  1. . F S RCLINE=$O(^RCY(344,RCRCPT,1,RCLINE)) Q:'RCLINE D
  1. .. ; Check that line is still in suspense
  1. .. S RCSUSP=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.01) Q:RCSUSP=""
  1. .. ; Receipt line comment
  1. .. S COMMENT=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",1.02) Q:$L(COMMENT)<3
  1. .. ; Date placed into suspense
  1. .. S DATE=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.02,"I") Q:DATE=""
  1. .. ; Placed into suspense by
  1. .. S USER=$$GET1^DIQ(344.01,RCLINE_","_RCRCPT_",",3.03,"I") Q:USER=""
  1. .. N FDA,ERR
  1. .. S FDA(344.73,"+1,",.01)=RCRCPT ;Receipt
  1. .. S FDA(344.73,"+1,",1)=RCLINE ;Scratchpad or Receipt Line Number
  1. .. S FDA(344.73,"+1,",2)=USER ;User
  1. .. S FDA(344.73,"+1,",3)=DATE ;Date/time ;
  1. .. S FDA(344.73,"+1,",4)=COMMENT ;Comment ;file entry
  1. .. D UPDATE^DIE(,"FDA","ERR")
  1. .. S RCNODE("CNT")=RCNODE("CNT")+1
  1. ;
  1. S RCNODE("END")=$$NOW^XLFDT
  1. S ^XTMP($T(+0),"FINISHED")=RCNODE("END")
  1. ; create MailMan message text
  1. S RCBODY(0)=0
  1. D ADD2TXT(.RCBODY,"Finished RCDPE COMMENT HISTORY file #344.73 initialization task.")
  1. D ADD2TXT(.RCBODY," Process begun: "_$$FMTE^XLFDT(RCNODE("BEG")))
  1. D ADD2TXT(.RCBODY," Process ended: "_$$FMTE^XLFDT(RCNODE("END")))
  1. D ADD2TXT(.RCBODY," Comment count: "_$$FMTE^XLFDT(RCNODE("CNT")))
  1. D ADD2TXT(.RCBODY,"Report generated by the "_$T(+0)_" post-initialization routine.")
  1. ;
  1. ; save MailMan message text
  1. M ^XTMP($T(+0),"MAIL MSG",$$NOW^XLFDT)=RCBODY
  1. ; send via MailMan
  1. S RCSUBJ="PRCA*4.5*321 Post Install Routine Completed"
  1. S RCTO(.5)="",RCTO(DUZ)="" ; POSTMASTER and user who queued it
  1. S RCTO("G.RCDPE PAYMENTS MGMT")=""
  1. S XMINSTR("FROM")="POSTMASTER"
  1. ;
  1. D SENDMSG^XMXAPI(DUZ,RCSUBJ,"RCBODY",.RCTO,.XMINSTR,.RCZR) ; send message
  1. Q
  1. ;
  1. ADD2TXT(TXARY,LN) ; add LN to TXARY for MailMan Message
  1. ; TXARY passed by ref.
  1. I $G(LN)'="" S TXARY(0)=$G(TXARY(0))+1,TXARY(TXARY(0),0)=LN
  1. Q
  1. ;
  1. PURGE ; Clear any existing history
  1. N DA,DIK,RCPURGE,SUB
  1. S SUB=0
  1. F S SUB=$O(^RCY(344.73,SUB)) Q:'SUB D
  1. .S DIK="^RCY(344.73,",DA=SUB D ^DIK
  1. K ^XTMP($T(+0))
  1. Q