- 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 Jan 18, 2025@02:51:48 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 ;