BPS34PRE ;AITC/PED - Pre-install routine for BPS*1*34 ;08/2022
;;1.0;E CLAIMS MGMT ENGINE;**34**;JUN 2004;Build 11
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*34 patch pre-install
;
Q
;
PRE ; Entry Point for pre-install
;
D MES^XPDUTL(" Starting pre-install for BPS*1*34")
;
; Update BPS NCPDP Other Payer Amt Paid Qual in file #9002313.2
;
D PDQUAL
;
D MES^XPDUTL(" Finished pre-install of BPS*1*34")
;
Q
;
PDQUAL ; Update Other Payer Amt Paid Qual
;
N BPSA,BPSFN,BPSID,BPSREC
;
S BPSID=$O(^BPS(9002313.2,"B",10,""))
I BPSID="" Q
S BPSFN=9002313.2
S BPSREC=BPSID_","
S BPSA(BPSFN,BPSREC,.02)="SALES TAX"
D FILE^DIE("","BPSA","")
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS34PRE 754 printed Dec 13, 2024@01:50:38 Page 2
BPS34PRE ;AITC/PED - Pre-install routine for BPS*1*34 ;08/2022
+1 ;;1.0;E CLAIMS MGMT ENGINE;**34**;JUN 2004;Build 11
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*34 patch pre-install
+5 ;
+6 QUIT
+7 ;
PRE ; Entry Point for pre-install
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install for BPS*1*34")
+3 ;
+4 ; Update BPS NCPDP Other Payer Amt Paid Qual in file #9002313.2
+5 ;
+6 DO PDQUAL
+7 ;
+8 DO MES^XPDUTL(" Finished pre-install of BPS*1*34")
+9 ;
+10 QUIT
+11 ;
PDQUAL ; Update Other Payer Amt Paid Qual
+1 ;
+2 NEW BPSA,BPSFN,BPSID,BPSREC
+3 ;
+4 SET BPSID=$ORDER(^BPS(9002313.2,"B",10,""))
+5 IF BPSID=""
QUIT
+6 SET BPSFN=9002313.2
+7 SET BPSREC=BPSID_","
+8 SET BPSA(BPSFN,BPSREC,.02)="SALES TAX"
+9 DO FILE^DIE("","BPSA","")
+10 ;
+11 QUIT
+12 ;