BPS31POST ;AITC/PD - Post-install for BPS*1.0*31 ;10/21/2014
;;1.0;E CLAIMS MGMT ENGINE;**31**;JUN 2004;Build 16
;;Per VA Directive 6402, this routine should not be modified.
;
; BPS*1*31 patch post install
;
Q
;
EN ; Entry Point for post-install
;
N COUNT
;
D MES^XPDUTL(" Starting post-install for BPS*1*31")
;
; Set MCCF TAS EDI Progress Flag to 1 for Unstranded Txns
D UNSTRAND
;
EX ; exit point
D BMES^XPDUTL(" Finished post-install of BPS*1*31")
Q
;
UNSTRAND ; Set MCCF TAS EDI Progress Flag to 1 for Unstranded Txns
;
N IEN
;
D BMES^XPDUTL(" Process NTR Unstranded Txns")
;
S COUNT=0
;
S IEN=""
F S IEN=$O(^BPSTL("C",3,IEN)) Q:'IEN D
. ; Only reset txns with Payer Response status of E UNSTRANDED
. I $$GET1^DIQ(9002313.57,IEN,4.0098)'["UNSTRANDED" Q
. ;
. ; Reset MCCF TAS EDI Progress Flag to 1 (Ready to Send)
. N BPSA,BPSFN,BPSREC
. S BPSFN=9002313.57
. S BPSREC=IEN_","
. S BPSA(BPSFN,BPSREC,20)=1
. D FILE^DIE("","BPSA","")
. ;
. ; Update count of how many txns reset to use in mail message
. S COUNT=COUNT+1
;
; E-mail results to development team
D MAIL(COUNT)
;
Q
;
MAIL(COUNT) ; E-mail development team # of txns reset
;
N BPSSITENAME,BPSSITENUMBER,BPSVASITE,BPSX,DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
;
S BPSVASITE=$$NS^XUAF4($$KSP^XUPARAM("INST"))
S BPSSITENAME=$P(BPSVASITE,"^")
S BPSSITENUMBER=$P(BPSVASITE,"^",2)
S XMSUB="BPS*1.0*31 Post Install Unstranded Txns"
S XMDUZ=BPSSITENUMBER_" - "_BPSSITENAME
I '$$PROD^XUPROD(1) S XMY(DUZ)=""
I $$PROD^XUPROD(1) D
. S XMY("Mark.Dawson3@domain.ext")=""
. S XMY("Paul.Devine@domain.ext")=""
S XMTEXT="BPSX("
S BPSX(1)=""
S BPSX(2)=COUNT_" unstranded txn(s) reset for site "_BPSSITENAME_" ("_BPSSITENUMBER_")."
S BPSX(3)=""
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS31POST 1829 printed Sep 02, 2024@18:35:58 Page 2
BPS31POST ;AITC/PD - Post-install for BPS*1.0*31 ;10/21/2014
+1 ;;1.0;E CLAIMS MGMT ENGINE;**31**;JUN 2004;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; BPS*1*31 patch post install
+5 ;
+6 QUIT
+7 ;
EN ; Entry Point for post-install
+1 ;
+2 NEW COUNT
+3 ;
+4 DO MES^XPDUTL(" Starting post-install for BPS*1*31")
+5 ;
+6 ; Set MCCF TAS EDI Progress Flag to 1 for Unstranded Txns
+7 DO UNSTRAND
+8 ;
EX ; exit point
+1 DO BMES^XPDUTL(" Finished post-install of BPS*1*31")
+2 QUIT
+3 ;
UNSTRAND ; Set MCCF TAS EDI Progress Flag to 1 for Unstranded Txns
+1 ;
+2 NEW IEN
+3 ;
+4 DO BMES^XPDUTL(" Process NTR Unstranded Txns")
+5 ;
+6 SET COUNT=0
+7 ;
+8 SET IEN=""
+9 FOR
SET IEN=$ORDER(^BPSTL("C",3,IEN))
if 'IEN
QUIT
Begin DoDot:1
+10 ; Only reset txns with Payer Response status of E UNSTRANDED
+11 IF $$GET1^DIQ(9002313.57,IEN,4.0098)'["UNSTRANDED"
QUIT
+12 ;
+13 ; Reset MCCF TAS EDI Progress Flag to 1 (Ready to Send)
+14 NEW BPSA,BPSFN,BPSREC
+15 SET BPSFN=9002313.57
+16 SET BPSREC=IEN_","
+17 SET BPSA(BPSFN,BPSREC,20)=1
+18 DO FILE^DIE("","BPSA","")
+19 ;
+20 ; Update count of how many txns reset to use in mail message
+21 SET COUNT=COUNT+1
End DoDot:1
+22 ;
+23 ; E-mail results to development team
+24 DO MAIL(COUNT)
+25 ;
+26 QUIT
+27 ;
MAIL(COUNT) ; E-mail development team # of txns reset
+1 ;
+2 NEW BPSSITENAME,BPSSITENUMBER,BPSVASITE,BPSX,DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+3 ;
+4 SET BPSVASITE=$$NS^XUAF4($$KSP^XUPARAM("INST"))
+5 SET BPSSITENAME=$PIECE(BPSVASITE,"^")
+6 SET BPSSITENUMBER=$PIECE(BPSVASITE,"^",2)
+7 SET XMSUB="BPS*1.0*31 Post Install Unstranded Txns"
+8 SET XMDUZ=BPSSITENUMBER_" - "_BPSSITENAME
+9 IF '$$PROD^XUPROD(1)
SET XMY(DUZ)=""
+10 IF $$PROD^XUPROD(1)
Begin DoDot:1
+11 SET XMY("Mark.Dawson3@domain.ext")=""
+12 SET XMY("Paul.Devine@domain.ext")=""
End DoDot:1
+13 SET XMTEXT="BPSX("
+14 SET BPSX(1)=""
+15 SET BPSX(2)=COUNT_" unstranded txn(s) reset for site "_BPSSITENAME_" ("_BPSSITENUMBER_")."
+16 SET BPSX(3)=""
+17 DO ^XMD
+18 ;
+19 QUIT