BPS19PRE ;ALB/DMB - Pre-install for BPS*1.0*19 ;10/21/2014
;;1.0;E CLAIMS MGMT ENGINE;**19**;JUN 2004;Build 18
;;Per VA Directive 6402, this routine should not be modified.
;
; NCPDP Continuous Maintenance Standards - BPS*1*19 patch pre-install
;
Q
;
EN ; Entry Point for post-install
D MES^XPDUTL(" Starting pre-install for BPS*1*19")
; Update the reject code description in BPS NCPDP REJECT CODES
D REJECTS
; Update the field names for BPS NCPPD FIELD DEFS
D FIELDS
;
EX ; exit point
;
D MES^XPDUTL(" Finished pre-install of BPS*1*19")
Q
;
REJECTS ;
; Update Reject Codes with new explanations
N LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
D MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
S CNT=0
F LINE=1:1 S DATA=$P($T(NRJCT+LINE),";;",2,99) Q:DATA="" D
. S DIE=9002313.93,NUM=$P(DATA,";",1)
. S DA=$O(^BPSF(DIE,"B",NUM,""))
. I 'DA Q ; quit if no IEN found for entry
. S NAME=$P(DATA,";",2),DR=".02////^S X=NAME",CNT=CNT+1
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
D MES^XPDUTL(" ")
Q
;
NRJCT ; New reject explanations
;;27;Product Identifier not FDA/NSDE Listed
;;30;Reversal request outside processor reversal window
;;31;No matching paid claim found for reversal request
;;43;Plan DB indicates the assoc DEA to submitted Prescriber ID is inactive
;;
FIELDS ;
; Update Field Defs with new descriptions
N LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
D MES^XPDUTL(" - Updating BPS NCPDP FIELD DEFS")
S CNT=0
F LINE=1:1 S DATA=$P($T(NFLDS+LINE),";;",2,99) Q:DATA="" D
. S NUM=$P(DATA,";",1)
. S DA=$O(^BPSF(9002313.91,"B",NUM,""))
. I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q
. S DIE=9002313.91,NAME=$P(DATA,";",2),DR=".03////^S X=NAME",CNT=CNT+1
. D ^DIE
D MES^XPDUTL(" - "_CNT_" entries updated")
D MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS")
D MES^XPDUTL(" ")
Q
;
NFLDS ; New field names
;;124;PAY TO ZIP/POSTAL ZONE
;;320;EMPLOYER TELEPHONE NUMBER
;;326;PATIENT TELEPHONE NUMBER
;;498.12;PRESCRIBER TELEPHONE NUMBER
;;550;HELP DESK TELEPHONE NUMBER
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS19PRE 2175 printed Sep 23, 2025@19:26:32 Page 2
BPS19PRE ;ALB/DMB - Pre-install for BPS*1.0*19 ;10/21/2014
+1 ;;1.0;E CLAIMS MGMT ENGINE;**19**;JUN 2004;Build 18
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; NCPDP Continuous Maintenance Standards - BPS*1*19 patch pre-install
+5 ;
+6 QUIT
+7 ;
EN ; Entry Point for post-install
+1 DO MES^XPDUTL(" Starting pre-install for BPS*1*19")
+2 ; Update the reject code description in BPS NCPDP REJECT CODES
+3 DO REJECTS
+4 ; Update the field names for BPS NCPPD FIELD DEFS
+5 DO FIELDS
+6 ;
EX ; exit point
+1 ;
+2 DO MES^XPDUTL(" Finished pre-install of BPS*1*19")
+3 QUIT
+4 ;
REJECTS ;
+1 ; Update Reject Codes with new explanations
+2 NEW LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
+3 DO MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
+4 SET CNT=0
+5 FOR LINE=1:1
SET DATA=$PIECE($TEXT(NRJCT+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+6 SET DIE=9002313.93
SET NUM=$PIECE(DATA,";",1)
+7 SET DA=$ORDER(^BPSF(DIE,"B",NUM,""))
+8 ; quit if no IEN found for entry
IF 'DA
QUIT
+9 SET NAME=$PIECE(DATA,";",2)
SET DR=".02////^S X=NAME"
SET CNT=CNT+1
+10 DO ^DIE
End DoDot:1
+11 DO MES^XPDUTL(" - "_CNT_" entries updated")
+12 DO MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
+13 DO MES^XPDUTL(" ")
+14 QUIT
+15 ;
NRJCT ; New reject explanations
+1 ;;27;Product Identifier not FDA/NSDE Listed
+2 ;;30;Reversal request outside processor reversal window
+3 ;;31;No matching paid claim found for reversal request
+4 ;;43;Plan DB indicates the assoc DEA to submitted Prescriber ID is inactive
+5 ;;
FIELDS ;
+1 ; Update Field Defs with new descriptions
+2 NEW LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
+3 DO MES^XPDUTL(" - Updating BPS NCPDP FIELD DEFS")
+4 SET CNT=0
+5 FOR LINE=1:1
SET DATA=$PIECE($TEXT(NFLDS+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+6 SET NUM=$PIECE(DATA,";",1)
+7 SET DA=$ORDER(^BPSF(9002313.91,"B",NUM,""))
+8 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM)
QUIT
+9 SET DIE=9002313.91
SET NAME=$PIECE(DATA,";",2)
SET DR=".03////^S X=NAME"
SET CNT=CNT+1
+10 DO ^DIE
End DoDot:1
+11 DO MES^XPDUTL(" - "_CNT_" entries updated")
+12 DO MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS")
+13 DO MES^XPDUTL(" ")
+14 QUIT
+15 ;
NFLDS ; New field names
+1 ;;124;PAY TO ZIP/POSTAL ZONE
+2 ;;320;EMPLOYER TELEPHONE NUMBER
+3 ;;326;PATIENT TELEPHONE NUMBER
+4 ;;498.12;PRESCRIBER TELEPHONE NUMBER
+5 ;;550;HELP DESK TELEPHONE NUMBER
+6 ;;
