BPS25PRE.m

BPS25PRE ;AITC/CKB - Pre-install for BPS*1.0*25 ;10/10/2018

 ;;1.0;E CLAIMS MGMT ENGINE;**24**;;Build 4

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ; MCCF EDI TAS ePharmacy - BPS*1*25 patch pre-install

 Q

 ;

EN ; Entry Point for pre-install

 D MES^XPDUTL(" Starting pre-install for BPS*1*25")

 ;

 ; Update Reject code explanation for file #9002313.93

 D REJECTS

 ;

EX ; Exit point

 D MES^XPDUTL(" Finished pre-install of BPS*1*25")

 Q

 ;

REJECTS ; Update Reject Code with new explanation

 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(URJCT+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

 ;

URJCT ; Updated reject explanation

 ;;559;ID Excluded Is Associated With A Sanctioned Pharmacy

 ;;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPS25PRE   1138     printed  Mar 13, 2025@20:55:10                                                                                                                                                                                                    Page 2

BPS25PRE  ;AITC/CKB - Pre-install for BPS*1.0*25 ;10/10/2018

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**24**;;Build 4

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; MCCF EDI TAS ePharmacy - BPS*1*25 patch pre-install

 +5        QUIT 

 +6       ;

EN        ; Entry Point for pre-install

 +1        DO MES^XPDUTL(" Starting pre-install for BPS*1*25")

 +2       ;

 +3       ; Update Reject code explanation for file #9002313.93

 +4        DO REJECTS

 +5       ;

EX        ; Exit point

 +1        DO MES^XPDUTL(" Finished pre-install of BPS*1*25")

 +2        QUIT 

 +3       ;

REJECTS   ; Update Reject Code with new explanation

 +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(URJCT+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      ;

URJCT     ; Updated reject explanation

 +1       ;;559;ID Excluded Is Associated With A Sanctioned Pharmacy

 +2       ;;

 +3       ;