BPS21PRE ;AITC/CKB - Pre-installroutine for BPS*1*21 ;2/21/2017
;;1.0;E CLAIMS MGMT ENGINE;**21**;JUN 2004;Build 28
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy Iteration 1 - BPS*1*21 patch pre-install
Q
;
EN ; Entry Point for pre-install
D MES^XPDUTL(" Starting pre-install for BPS*1*21")
;
; Update descriptions in the BPS NCPDP FIELD DEF file #9002313.91
D FIELDS
;
; Update Reject codes in BPS NCPDP REJECT CODES file #9002313.93
D REJECTS
;
EX ; Exit point
D MES^XPDUTL(" Finished pre-install of BPS*1*21")
Q
;
FIELDS ; Update Fields 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 DIE=9002313.91,NUM=$P(DATA,";",1)
. S DA=$O(^BPSF(DIE,"B",NUM,""))
. I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q
. S 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 ; Updated field names
;;409;INGREDIENT COST SUBMITTED
;;431;OTHER PAYER AMOUNT PAID
;;433;PATIENT PAID AMOUNT SUBMITTED
;;579;ASSOC RX/SERVICE PROV ID QUAL
;;580;ASSOC RX/SERVICE PROVIDER ID
;;581;ASSOC RX/SERVICE REF NUM QUAL
;;582;ASSOC RX/SERVICE FILL NUMBER
;
;
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 D MES^XPDUTL(" - No IEN found for entry "_NUM) Q
. 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 ; Updated reject explanations
;;280;Prior Authorization ID Submitted is not used for this Transaction Code
;;EV;M/I Prior Authorization ID Submitted
;;N7;Use Prior Authorization ID Provided During Transition Period
;;N8;Use Prior Authorization ID Provided For Emergency Fill
;;N9;Use Prior Authorization ID Provided For Level of Care Change
;;635;Employer Country Code Value Not Supported
;;637;Entity Country Code Value Not Supported
;;638;Facility Country Code Value Not Supported
;;639;Patient ID Associated Country Code Value Not Supported
;;640;Pay to Country Code Value Not Supported
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS21PRE 2610 printed Apr 09, 2024@20:57:43 Page 2
BPS21PRE ;AITC/CKB - Pre-installroutine for BPS*1*21 ;2/21/2017
+1 ;;1.0;E CLAIMS MGMT ENGINE;**21**;JUN 2004;Build 28
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy Iteration 1 - BPS*1*21 patch pre-install
+5 QUIT
+6 ;
EN ; Entry Point for pre-install
+1 DO MES^XPDUTL(" Starting pre-install for BPS*1*21")
+2 ;
+3 ; Update descriptions in the BPS NCPDP FIELD DEF file #9002313.91
+4 DO FIELDS
+5 ;
+6 ; Update Reject codes in BPS NCPDP REJECT CODES file #9002313.93
+7 DO REJECTS
+8 ;
EX ; Exit point
+1 DO MES^XPDUTL(" Finished pre-install of BPS*1*21")
+2 QUIT
+3 ;
FIELDS ; Update Fields Defs with new descriptions
+1 NEW LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
+2 DO MES^XPDUTL(" - Updating BPS NCPDP FIELD DEFS")
+3 SET CNT=0
+4 FOR LINE=1:1
SET DATA=$PIECE($TEXT(NFLDS+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+5 SET DIE=9002313.91
SET NUM=$PIECE(DATA,";",1)
+6 SET DA=$ORDER(^BPSF(DIE,"B",NUM,""))
+7 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM)
QUIT
+8 SET NAME=$PIECE(DATA,";",2)
SET DR=".03////^S X=NAME"
SET CNT=CNT+1
+9 DO ^DIE
End DoDot:1
+10 DO MES^XPDUTL(" - "_CNT_" entries updated")
+11 DO MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS")
+12 DO MES^XPDUTL(" ")
+13 QUIT
+14 ;
NFLDS ; Updated field names
+1 ;;409;INGREDIENT COST SUBMITTED
+2 ;;431;OTHER PAYER AMOUNT PAID
+3 ;;433;PATIENT PAID AMOUNT SUBMITTED
+4 ;;579;ASSOC RX/SERVICE PROV ID QUAL
+5 ;;580;ASSOC RX/SERVICE PROVIDER ID
+6 ;;581;ASSOC RX/SERVICE REF NUM QUAL
+7 ;;582;ASSOC RX/SERVICE FILL NUMBER
+8 ;
+9 ;
REJECTS ; Update Reject Codes with new explanations
+1 NEW LINE,DATA,NUM,NAME,DA,DIE,DR,CNT
+2 DO MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES")
+3 SET CNT=0
+4 FOR LINE=1:1
SET DATA=$PIECE($TEXT(NRJCT+LINE),";;",2,99)
if DATA=""
QUIT
Begin DoDot:1
+5 SET DIE=9002313.93
SET NUM=$PIECE(DATA,";",1)
+6 SET DA=$ORDER(^BPSF(DIE,"B",NUM,""))
+7 IF 'DA
DO MES^XPDUTL(" - No IEN found for entry "_NUM)
QUIT
+8 SET NAME=$PIECE(DATA,";",2)
SET DR=".02////^S X=NAME"
SET CNT=CNT+1
+9 DO ^DIE
End DoDot:1
+10 DO MES^XPDUTL(" - "_CNT_" entries updated")
+11 DO MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES")
+12 DO MES^XPDUTL(" ")
+13 QUIT
+14 ;
NRJCT ; Updated reject explanations
+1 ;;280;Prior Authorization ID Submitted is not used for this Transaction Code
+2 ;;EV;M/I Prior Authorization ID Submitted
+3 ;;N7;Use Prior Authorization ID Provided During Transition Period
+4 ;;N8;Use Prior Authorization ID Provided For Emergency Fill
+5 ;;N9;Use Prior Authorization ID Provided For Level of Care Change
+6 ;;635;Employer Country Code Value Not Supported
+7 ;;637;Entity Country Code Value Not Supported
+8 ;;638;Facility Country Code Value Not Supported
+9 ;;639;Patient ID Associated Country Code Value Not Supported
+10 ;;640;Pay to Country Code Value Not Supported
