BPS39PRE ;AITC/PED - Pre-install routine for BPS*1*39 ;12/30/2024
;;1.0;E CLAIMS MGMT ENGINE;**39**;JUN 2004;Build 14
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*39 patch pre-install
;
Q
;
PRE ; Entry Point for pre-install
;
D MES^XPDUTL(" Starting pre-install for BPS*1*39")
;
; Update Other Prescriber ID Qualifier descriptions in file #9002313.41.
;
D BPS41
;
D MES^XPDUTL(" Finished pre-install of BPS*1*39")
;
Q
;
BPS41 ; Update file 9002313.41
N CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X
D MES^XPDUTL(" - Updating BPS NCPDP OTHER PRESCRIBER QUALIFIER")
S CNT=0
F LINE=1:1 S DATA=$P($T(BPS41CDS+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S NAME=$P(DATA,";",2)
. S DIE=9002313.41
. 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 PRESCRIBER QUALIFIER")
D MES^XPDUTL(" ")
Q
;
BPS41CDS ; Updated DAW code
;;18;No Prescriber ID, No RX Associated to the transaction
;;
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS39PRE 1251 printed Sep 23, 2025@19:26:52 Page 2
BPS39PRE ;AITC/PED - Pre-install routine for BPS*1*39 ;12/30/2024
+1 ;;1.0;E CLAIMS MGMT ENGINE;**39**;JUN 2004;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*39 patch pre-install
+5 ;
+6 QUIT
+7 ;
PRE ; Entry Point for pre-install
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install for BPS*1*39")
+3 ;
+4 ; Update Other Prescriber ID Qualifier descriptions in file #9002313.41.
+5 ;
+6 DO BPS41
+7 ;
+8 DO MES^XPDUTL(" Finished pre-install of BPS*1*39")
+9 ;
+10 QUIT
+11 ;
BPS41 ; Update file 9002313.41
+1 NEW CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X
+2 DO MES^XPDUTL(" - Updating BPS NCPDP OTHER PRESCRIBER QUALIFIER")
+3 SET CNT=0
+4 FOR LINE=1:1
SET DATA=$PIECE($TEXT(BPS41CDS+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.41
+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 PRESCRIBER QUALIFIER")
+18 DO MES^XPDUTL(" ")
+19 QUIT
+20 ;
BPS41CDS ; Updated DAW code
+1 ;;18;No Prescriber ID, No RX Associated to the transaction
+2 ;;
+3 ;
+4 QUIT
+5 ;
