BPS29PRE ;AITC/PD - Pre-install for BPS*1.0*29 ;1/4/2021
;;1.0;E CLAIMS MGMT ENGINE;**29**;JUN 2004;Build 41
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*29 patch pre-install
Q
;
PRE ; Pre-install functions are coded here.
;
D MES^XPDUTL(" Starting pre-install of BPS*1.0*29")
;
; Update field .02 in BPS NCPDP REJECT CODES
D REJECTS
;
D MES^XPDUTL(" Finished pre-install of BPS*1.0*29")
Q
;
REJECTS ;
; Update Reject Codes with new explanations
N CNT,DA,DATA,DIE,DR,LINE,NAME,NUM
D MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
S CNT=0
F LINE=1:1 S DATA=$P($T(REJECTS1+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S DIE=9002313.93
. S DA=$O(^BPSF(DIE,"B",NUM,""))
. I 'DA Q ; quit if no IEN found for entry
. S CNT=CNT+1
. S NAME=$P(DATA,";",2)
. S DR=".02////^S X=NAME"
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
D MES^XPDUTL(" ")
Q
;
REJECTS1 ; Updated Reject Code explanations
;;eC;CHAMPVA-NON BILLABLE
;;eT;TRICARE-NON BILLABLE
;;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS29PRE 1157 printed Sep 23, 2025@19:26:44 Page 2
BPS29PRE ;AITC/PD - Pre-install for BPS*1.0*29 ;1/4/2021
+1 ;;1.0;E CLAIMS MGMT ENGINE;**29**;JUN 2004;Build 41
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*29 patch pre-install
+5 QUIT
+6 ;
PRE ; Pre-install functions are coded here.
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install of BPS*1.0*29")
+3 ;
+4 ; Update field .02 in BPS NCPDP REJECT CODES
+5 DO REJECTS
+6 ;
+7 DO MES^XPDUTL(" Finished pre-install of BPS*1.0*29")
+8 QUIT
+9 ;
REJECTS ;
+1 ; Update Reject Codes with new explanations
+2 NEW CNT,DA,DATA,DIE,DR,LINE,NAME,NUM
+3 DO MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
+4 SET CNT=0
+5 FOR LINE=1:1
SET DATA=$PIECE($TEXT(REJECTS1+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+6 SET NUM=$PIECE(DATA,";",1)
+7 SET DIE=9002313.93
+8 SET DA=$ORDER(^BPSF(DIE,"B",NUM,""))
+9 ; quit if no IEN found for entry
IF 'DA
QUIT
+10 SET CNT=CNT+1
+11 SET NAME=$PIECE(DATA,";",2)
+12 SET DR=".02////^S X=NAME"
+13 DO ^DIE
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 ;
REJECTS1 ; Updated Reject Code explanations
+1 ;;eC;CHAMPVA-NON BILLABLE
+2 ;;eT;TRICARE-NON BILLABLE
+3 ;;
+4 ;
