BPS29PRE.m

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 ---BPS29PRE   1157     printed  Apr 09, 2024@20:56:03                                                                                                                                                                                                    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       ;