BPS37PRE ;AITC/PED - Pre-install routine for BPS*1*37 ;12/04/2023
;;1.0;E CLAIMS MGMT ENGINE;**37**;JUN 2004;Build 16
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*37 patch pre-install
;
Q
;
PRE ; Entry Point for pre-install
;
D MES^XPDUTL(" Starting pre-install for BPS*1*37")
;
; Update Reject Code explanations in file #9002313.93.
;
D REJECT
;
D MES^XPDUTL(" Finished pre-install of BPS*1*37")
;
Q
;
REJECT ; Update Reject Codes with new explanations.
N CNT,DA,DIE,DR,LINE,DATA,NUM,NAME,X
D MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
S CNT=0
F LINE=1:1 S DATA=$P($T(URJCT+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S NAME=$P(DATA,";",2)
. S DIE=9002313.93
. S DA=$O(^BPSF(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
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
D MES^XPDUTL(" ")
Q
;
URJCT ; Updated reject explanation
;;367;Regulatory Fee Amount Submitted Is Not Used For This Transaction Code
;;HA;M/I Regulatory Fee Amount Submitted
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS37PRE 1244 printed Sep 23, 2025@19:26:50 Page 2
BPS37PRE ;AITC/PED - Pre-install routine for BPS*1*37 ;12/04/2023
+1 ;;1.0;E CLAIMS MGMT ENGINE;**37**;JUN 2004;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*37 patch pre-install
+5 ;
+6 QUIT
+7 ;
PRE ; Entry Point for pre-install
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install for BPS*1*37")
+3 ;
+4 ; Update Reject Code explanations in file #9002313.93.
+5 ;
+6 DO REJECT
+7 ;
+8 DO MES^XPDUTL(" Finished pre-install of BPS*1*37")
+9 ;
+10 QUIT
+11 ;
REJECT ; Update Reject Codes with new explanations.
+1 NEW CNT,DA,DIE,DR,LINE,DATA,NUM,NAME,X
+2 DO MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
+3 SET CNT=0
+4 FOR LINE=1:1
SET DATA=$PIECE($TEXT(URJCT+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.93
+8 SET DA=$ORDER(^BPSF(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 DO MES^XPDUTL(" - "_CNT_" entries updated")
+15 DO MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
+16 DO MES^XPDUTL(" ")
+17 QUIT
+18 ;
URJCT ; Updated reject explanation
+1 ;;367;Regulatory Fee Amount Submitted Is Not Used For This Transaction Code
+2 ;;HA;M/I Regulatory Fee Amount Submitted
+3 ;;
+4 ;
