BPS42PRE ;AITC/PED - Pre-install routine for BPS*1*42 ;12/30/2025
;;1.0;E CLAIMS MGMT ENGINE;**42**;JUN 2004;Build 11
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*42 patch pre-install
;
Q
;
PRE ; Entry Point for pre-install
;
D MES^XPDUTL(" Starting pre-install for BPS*1*42")
;
; Update Other Payer Amount Paid Qualifier descriptions in file #9002313.2.
D BPS2
;
; Update DAW Code status in file #9002313.24.
D BPS24
;
; Update Benefit State Indicator description in file #9002313.35.
D BPS35
;
D MES^XPDUTL(" Finished pre-install of BPS*1*42")
;
Q
;
BPS2 ; Update file 9002313.2
N CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X
D MES^XPDUTL(" - Updating BPS NCPDP OTHER PAYER AMT PAID QUAL")
S CNT=0
F LINE=1:1 S DATA=$P($T(BPS2CDS+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S NAME=$P(DATA,";",2)
. S DIE=9002313.2
. S DA=$O(^BPS(DIE,"B",NUM,""))
. I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q
. S DR=".02////^S X=NAME"
. D ^DIE
. S CNT=CNT+1
. Q
S ENTRY="entries"
I CNT=1 S ENTRY="entry"
D MES^XPDUTL(" - "_CNT_" "_ENTRY_" updated")
D MES^XPDUTL(" - Done with BPS NCPDP OTHER PAYER AMT PAID QUAL")
D MES^XPDUTL(" ")
Q
;
BPS2CDS ; Updated Other Payer Amt Paid Qual
;;01;DELIVERY
;;02;SHIPPING
;;03;POSTAGE
;;04;ADMINISTRATIVE
;;
;
Q
;
BPS24 ; Update file 9002313.24
N DA,DIE,DR
D MES^XPDUTL(" - Updating BPS NCPDP DAW CODE")
S DIE=9002313.24
S DA=$O(^BPS(DIE,"B","A",""))
I 'DA D MES^XPDUTL(" - No IEN found for entry A") Q
S DR="2////1"
D ^DIE
D MES^XPDUTL(" - 1 entry updated")
D MES^XPDUTL(" - Done with BPS NCPDP DAW CODE")
D MES^XPDUTL(" ")
Q
;
BPS35 ; Update file 9002313.35
N DA,DIE,DR,NAME,X
D MES^XPDUTL(" - Updating BPS NCPDP BENEFIT STAGE INDICATOR")
S CNT=0
S DIE=9002313.35
S DA=$O(^BPS(DIE,"B",51,""))
I 'DA D MES^XPDUTL(" - No IEN found for entry 51") Q
S NAME="PAID UNDER THE PART B BENEFIT OF THE MEDICARE HEALTH PLAN FOR A QMB DUAL ELIGIBLE BENEFICIARY. PHARMACY SHOULD NOT ATTEMPT TO COLLECT COST-SHARE, BUT INSTEAD SHOULD ATTEMPT TO BILL COB TO MEDICAID COVERAGE."
S DR=".02////^S X=NAME"
D ^DIE
D MES^XPDUTL(" - 1 entry updated")
D MES^XPDUTL(" - Done with BPS NCPDP BENEFIT STAGE INDICATOR")
D MES^XPDUTL(" ")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS42PRE 2366 printed Jul 22, 2026@14:58:37 Page 2
BPS42PRE ;AITC/PED - Pre-install routine for BPS*1*42 ;12/30/2025
+1 ;;1.0;E CLAIMS MGMT ENGINE;**42**;JUN 2004;Build 11
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*42 patch pre-install
+5 ;
+6 QUIT
+7 ;
PRE ; Entry Point for pre-install
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install for BPS*1*42")
+3 ;
+4 ; Update Other Payer Amount Paid Qualifier descriptions in file #9002313.2.
+5 DO BPS2
+6 ;
+7 ; Update DAW Code status in file #9002313.24.
+8 DO BPS24
+9 ;
+10 ; Update Benefit State Indicator description in file #9002313.35.
+11 DO BPS35
+12 ;
+13 DO MES^XPDUTL(" Finished pre-install of BPS*1*42")
+14 ;
+15 QUIT
+16 ;
BPS2 ; Update file 9002313.2
+1 NEW CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X
+2 DO MES^XPDUTL(" - Updating BPS NCPDP OTHER PAYER AMT PAID QUAL")
+3 SET CNT=0
+4 FOR LINE=1:1
SET DATA=$PIECE($TEXT(BPS2CDS+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+5 SET NUM=$PIECE(DATA,";",1)
+6 SET NAME=$PIECE(DATA,";",2)
+7 SET DIE=9002313.2
+8 SET DA=$ORDER(^BPS(DIE,"B",NUM,""))
+9 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM)
QUIT
+10 SET DR=".02////^S X=NAME"
+11 DO ^DIE
+12 SET CNT=CNT+1
+13 QUIT
End DoDot:1
+14 SET ENTRY="entries"
+15 IF CNT=1
SET ENTRY="entry"
+16 DO MES^XPDUTL(" - "_CNT_" "_ENTRY_" updated")
+17 DO MES^XPDUTL(" - Done with BPS NCPDP OTHER PAYER AMT PAID QUAL")
+18 DO MES^XPDUTL(" ")
+19 QUIT
+20 ;
BPS2CDS ; Updated Other Payer Amt Paid Qual
+1 ;;01;DELIVERY
+2 ;;02;SHIPPING
+3 ;;03;POSTAGE
+4 ;;04;ADMINISTRATIVE
+5 ;;
+6 ;
+7 QUIT
+8 ;
BPS24 ; Update file 9002313.24
+1 NEW DA,DIE,DR
+2 DO MES^XPDUTL(" - Updating BPS NCPDP DAW CODE")
+3 SET DIE=9002313.24
+4 SET DA=$ORDER(^BPS(DIE,"B","A",""))
+5 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry A")
QUIT
+6 SET DR="2////1"
+7 DO ^DIE
+8 DO MES^XPDUTL(" - 1 entry updated")
+9 DO MES^XPDUTL(" - Done with BPS NCPDP DAW CODE")
+10 DO MES^XPDUTL(" ")
+11 QUIT
+12 ;
BPS35 ; Update file 9002313.35
+1 NEW DA,DIE,DR,NAME,X
+2 DO MES^XPDUTL(" - Updating BPS NCPDP BENEFIT STAGE INDICATOR")
+3 SET CNT=0
+4 SET DIE=9002313.35
+5 SET DA=$ORDER(^BPS(DIE,"B",51,""))
+6 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry 51")
QUIT
+7 SET NAME="PAID UNDER THE PART B BENEFIT OF THE MEDICARE HEALTH PLAN FOR A QMB DUAL ELIGIBLE BENEFICIARY. PHARMACY SHOULD NOT ATTEMPT TO COLLECT COST-SHARE, BUT INSTEAD SHOULD ATTEMPT TO BILL COB TO MEDICAID COVERAGE."
+8 SET DR=".02////^S X=NAME"
+9 DO ^DIE
+10 DO MES^XPDUTL(" - 1 entry updated")
+11 DO MES^XPDUTL(" - Done with BPS NCPDP BENEFIT STAGE INDICATOR")
+12 DO MES^XPDUTL(" ")
+13 QUIT
+14 ;
