BPS27POST ;AITC/PD - Post-install for BPS*1.0*27; 01/15/2020
;;1.0;E CLAIMS MGMT ENGINE;**27**;JUN 2004;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; Post-install to add entries to the queue used for
; transmitting claims to TAS. Queue = ^BPSTL("C")
; Database: BPS LOG OF TRANSACTIONS (#9002313.57)
; Field: MCCF EDI TAS PROGRESS (#20)
;
; Routine will calculate the starting date to be 10/01
; of the current fiscal year.
;
;
EN ; Post-install Entry Point
;
D MES^XPDUTL(" Starting post-install of BPS*1.0*27")
;
; Initialize ^BPSTL("C") index
I $D(^BPSTL("C")) D INIT
; Add entries to ^BPSTL("C")
D ADD
; Add proxy users
D PROXY
;
D MES^XPDUTL(" Finished post-install of BPS*1.0*27")
Q
;
INIT ; Clear ^BPSTL("C") index
;
N BPS1,BPS57
;
S BPS1=""
F S BPS1=$O(^BPSTL("C",BPS1)) Q:'BPS1 D
. S BPS57=0
. F S BPS57=$O(^BPSTL("C",BPS1,BPS57)) Q:'BPS57 D
. . N BPSA,BPSFN,BPSREC
. . S BPSFN=9002313.57
. . S BPSREC=BPS57_","
. . S BPSA(BPSFN,BPSREC,20)=""
. . D FILE^DIE("","BPSA","")
Q
;
ADD ; Add new entries to ^BPSTL("C")
; Using the AH index and the calculated date, add entries
; to the queue that are not already in the queue. Set
; the value to 1.
;
N BPS57,BPSDATE,COUNT
;
S BPSDATE=3191001
;
D MES^XPDUTL(" - Updating BPS LOG OF TRANSACTIONS")
S COUNT=0
;
F S BPSDATE=$O(^BPSTL("AH",BPSDATE)) Q:'BPSDATE D
. S BPS57=0
. F S BPS57=$O(^BPSTL("AH",BPSDATE,BPS57)) Q:'BPS57 D
. . ; Don't include entries where SUBMIT DATE is less than 3191001
. . I $$GET1^DIQ(9002313.57,BPS57,6,"I")<3191001 Q
. . ; Don't include entries with Field #20 already set
. . I $$GET1^DIQ(9002313.57,BPS57,20)'="" Q
. . ; Don't include non-billable transactions
. . I $$GET1^DIQ(9002313.57,BPS57,19,"I")'="N" D
. . . N BPSA,BPSFN,BPSREC
. . . S BPSFN=9002313.57
. . . S BPSREC=BPS57_","
. . . S BPSA(BPSFN,BPSREC,20)=1
. . . D FILE^DIE("","BPSA","")
. . . S COUNT=COUNT+1
;
D MES^XPDUTL(" - "_COUNT_" entries updated")
D MES^XPDUTL(" - Done with BPS LOG OF TRANSACTIONS")
D MES^XPDUTL(" ")
;
Q
;
PROXY ; Add proxy users if they don't already exist
;
I '$O(^VA(200,"B","BPSTAS,APPLICATION PROXY",0)) D
. N X
. S X=$$CREATE^XUSAP("BPSTAS,APPLICATION PROXY","","BPS EPHARMACY RPCS")
;
I '$O(^VA(200,"B","IBTAS,APPLICATION PROXY",0)) D
. N X
. S X=$$CREATE^XUSAP("IBTAS,APPLICATION PROXY","","IBTAS EBILLING RPCS")
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS27POST 2531 printed Sep 23, 2025@19:26:41 Page 2
BPS27POST ;AITC/PD - Post-install for BPS*1.0*27; 01/15/2020
+1 ;;1.0;E CLAIMS MGMT ENGINE;**27**;JUN 2004;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; Post-install to add entries to the queue used for
+7 ; transmitting claims to TAS. Queue = ^BPSTL("C")
+8 ; Database: BPS LOG OF TRANSACTIONS (#9002313.57)
+9 ; Field: MCCF EDI TAS PROGRESS (#20)
+10 ;
+11 ; Routine will calculate the starting date to be 10/01
+12 ; of the current fiscal year.
+13 ;
+14 ;
EN ; Post-install Entry Point
+1 ;
+2 DO MES^XPDUTL(" Starting post-install of BPS*1.0*27")
+3 ;
+4 ; Initialize ^BPSTL("C") index
+5 IF $DATA(^BPSTL("C"))
DO INIT
+6 ; Add entries to ^BPSTL("C")
+7 DO ADD
+8 ; Add proxy users
+9 DO PROXY
+10 ;
+11 DO MES^XPDUTL(" Finished post-install of BPS*1.0*27")
+12 QUIT
+13 ;
INIT ; Clear ^BPSTL("C") index
+1 ;
+2 NEW BPS1,BPS57
+3 ;
+4 SET BPS1=""
+5 FOR
SET BPS1=$ORDER(^BPSTL("C",BPS1))
if 'BPS1
QUIT
Begin DoDot:1
+6 SET BPS57=0
+7 FOR
SET BPS57=$ORDER(^BPSTL("C",BPS1,BPS57))
if 'BPS57
QUIT
Begin DoDot:2
+8 NEW BPSA,BPSFN,BPSREC
+9 SET BPSFN=9002313.57
+10 SET BPSREC=BPS57_","
+11 SET BPSA(BPSFN,BPSREC,20)=""
+12 DO FILE^DIE("","BPSA","")
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
ADD ; Add new entries to ^BPSTL("C")
+1 ; Using the AH index and the calculated date, add entries
+2 ; to the queue that are not already in the queue. Set
+3 ; the value to 1.
+4 ;
+5 NEW BPS57,BPSDATE,COUNT
+6 ;
+7 SET BPSDATE=3191001
+8 ;
+9 DO MES^XPDUTL(" - Updating BPS LOG OF TRANSACTIONS")
+10 SET COUNT=0
+11 ;
+12 FOR
SET BPSDATE=$ORDER(^BPSTL("AH",BPSDATE))
if 'BPSDATE
QUIT
Begin DoDot:1
+13 SET BPS57=0
+14 FOR
SET BPS57=$ORDER(^BPSTL("AH",BPSDATE,BPS57))
if 'BPS57
QUIT
Begin DoDot:2
+15 ; Don't include entries where SUBMIT DATE is less than 3191001
+16 IF $$GET1^DIQ(9002313.57,BPS57,6,"I")<3191001
QUIT
+17 ; Don't include entries with Field #20 already set
+18 IF $$GET1^DIQ(9002313.57,BPS57,20)'=""
QUIT
+19 ; Don't include non-billable transactions
+20 IF $$GET1^DIQ(9002313.57,BPS57,19,"I")'="N"
Begin DoDot:3
+21 NEW BPSA,BPSFN,BPSREC
+22 SET BPSFN=9002313.57
+23 SET BPSREC=BPS57_","
+24 SET BPSA(BPSFN,BPSREC,20)=1
+25 DO FILE^DIE("","BPSA","")
+26 SET COUNT=COUNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+27 ;
+28 DO MES^XPDUTL(" - "_COUNT_" entries updated")
+29 DO MES^XPDUTL(" - Done with BPS LOG OF TRANSACTIONS")
+30 DO MES^XPDUTL(" ")
+31 ;
+32 QUIT
+33 ;
PROXY ; Add proxy users if they don't already exist
+1 ;
+2 IF '$ORDER(^VA(200,"B","BPSTAS,APPLICATION PROXY",0))
Begin DoDot:1
+3 NEW X
+4 SET X=$$CREATE^XUSAP("BPSTAS,APPLICATION PROXY","","BPS EPHARMACY RPCS")
End DoDot:1
+5 ;
+6 IF '$ORDER(^VA(200,"B","IBTAS,APPLICATION PROXY",0))
Begin DoDot:1
+7 NEW X
+8 SET X=$$CREATE^XUSAP("IBTAS,APPLICATION PROXY","","IBTAS EBILLING RPCS")
End DoDot:1
+9 ;
+10 QUIT
+11 ;
