- 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 Mar 13, 2025@20:55:07 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
