BPS38PRE.m

BPS38PRE ;AITC/PED - Pre-install routine for BPS*1*38 ;06/03/2024

 ;;1.0;E CLAIMS MGMT ENGINE;**38**;JUN 2004;Build 7

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

 ;

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

 ;

 Q

 ;

PRE ; Entry Point for pre-install

 ;

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

 ;

 ; Update Reject Code explanations in file #9002313.93.

 ;

 D BPS24

 D BPS25

 D BPS93

 ;

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

 ;

 Q

 ;

BPS24 ; Update file 9002313.24

 N CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X

 D MES^XPDUTL("   - Updating BPS NCPDP DAW CODE")

 S CNT=0

 F LINE=1:1 S DATA=$P($T(BPS24CDS+LINE),";;",2,99) Q:DATA=""  D

 . S NUM=$P(DATA,";",1)

 . S NAME=$P(DATA,";",2)

 . S DIE=9002313.24

 . S DA=$O(^BPS(DIE,"B",NUM,""))

 . I 'DA D MES^XPDUTL("     - No IEN found for entry "_NUM) Q

 . S DR="1////^S X=NAME"

 . D ^DIE

 . S CNT=CNT+1

 . Q

 S ENTRY="entries"

 I CNT=1 S ENTRY="entry"

 D MES^XPDUTL("     - "_CNT_" "_ENTRY_" updated")

 D MES^XPDUTL("   - Done with BPS NCPDP DAW CODE")

 D MES^XPDUTL(" ")

 Q

 ;

BPS24CDS ; Updated DAW code

 ;;9;SUBSTITUTION ALLOWED BY PRESCRIBER BUT PLAN REQUESTS BRAND OR REFERENCE PRODUCT

 ;;

 ;

 Q

 ;

BPS25 ; Update file 9002313.25

 N CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X

 D MES^XPDUTL("   - Updating BPS NCPDP CLARIFICATION CODES")

 S CNT=0

 F LINE=1:1 S DATA=$P($T(BPS25CDS+LINE),";;",2,99) Q:DATA=""  D

 . S NUM=$P(DATA,";",1)

 . S NAME=$P(DATA,";",2)

 . S DIE=9002313.25

 . S DA=$O(^BPS(DIE,"B",NUM,""))

 . I 'DA D MES^XPDUTL("     - No IEN found for entry "_NUM) Q

 . S DR=".02////^S X=NAME"

 . D ^DIE

 . S CNT=CNT+1

 . Q

 S ENTRY="entries"

 I CNT=1 S ENTRY="entry"

 D MES^XPDUTL("     - "_CNT_" "_ENTRY_" updated")

 D MES^XPDUTL("   - Done with BPS NCPDP CLARIFICATION CODES")

 D MES^XPDUTL(" ")

 Q

 ;

BPS25CDS ; Updated clarification code

 ;;6;CONTINUATION DOSE AFTER STARTER DOSE

 ;;

 ;

 Q

 ;

BPS93 ; Update file 9002313.93

 N CNT,DA,DIE,DR,LINE,DATA,NUM,NAME,X

 D MES^XPDUTL("   - Updating BPS NCPDP REJECT CODES")

 S CNT=0

 F LINE=1:1 S DATA=$P($T(BPS93CDS+LINE),";;",2,99) Q:DATA=""  D

 . S NUM=$P(DATA,";",1)

 . S NAME=$P(DATA,";",2)

 . S DIE=9002313.93

 . S DA=$O(^BPSF(DIE,"B",NUM,""))

 . I 'DA D MES^XPDUTL("     - No IEN found for entry "_NUM) Q

 . S DR=".02////^S X=NAME"

 . D ^DIE

 . S CNT=CNT+1

 . Q

 D MES^XPDUTL("     - "_CNT_" entries updated")

 D MES^XPDUTL("   - Done with BPS NCPDP REJECT CODES")

 D MES^XPDUTL(" ")

 Q

 ;

BPS93CDS ; Updated reject explanation

 ;;362;Patient Pay Amount Reported is not used for this Transaction Code

 ;;DO1;Beneficiary is not a participant in this Medicare Rx Payment Plan

 ;;DX;M/I Patient Pay Amount Reported

 ;;

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPS38PRE   2788     printed  Mar 13, 2025@20:55:21                                                                                                                                                                                                    Page 2

BPS38PRE  ;AITC/PED - Pre-install routine for BPS*1*38 ;06/03/2024

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**38**;JUN 2004;Build 7

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

 +3       ;

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

 +5       ;

 +6        QUIT 

 +7       ;

PRE       ; Entry Point for pre-install

 +1       ;

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

 +3       ;

 +4       ; Update Reject Code explanations in file #9002313.93.

 +5       ;

 +6        DO BPS24

 +7        DO BPS25

 +8        DO BPS93

 +9       ;

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

 +11      ;

 +12       QUIT 

 +13      ;

BPS24     ; Update file 9002313.24

 +1        NEW CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X

 +2        DO MES^XPDUTL("   - Updating BPS NCPDP DAW CODE")

 +3        SET CNT=0

 +4        FOR LINE=1:1

               SET DATA=$PIECE($TEXT(BPS24CDS+LINE),";;",2,99)

               if DATA=""

                   QUIT 

               Begin DoDot:1

 +5                SET NUM=$PIECE(DATA,";",1)

 +6                SET NAME=$PIECE(DATA,";",2)

 +7                SET DIE=9002313.24

 +8                SET DA=$ORDER(^BPS(DIE,"B",NUM,""))

 +9                IF 'DA

                       DO MES^XPDUTL("     - No IEN found for entry "_NUM)

                       QUIT 

 +10               SET DR="1////^S X=NAME"

 +11               DO ^DIE

 +12               SET CNT=CNT+1

 +13               QUIT 

               End DoDot:1

 +14       SET ENTRY="entries"

 +15       IF CNT=1

               SET ENTRY="entry"

 +16       DO MES^XPDUTL("     - "_CNT_" "_ENTRY_" updated")

 +17       DO MES^XPDUTL("   - Done with BPS NCPDP DAW CODE")

 +18       DO MES^XPDUTL(" ")

 +19       QUIT 

 +20      ;

BPS24CDS  ; Updated DAW code

 +1       ;;9;SUBSTITUTION ALLOWED BY PRESCRIBER BUT PLAN REQUESTS BRAND OR REFERENCE PRODUCT

 +2       ;;

 +3       ;

 +4        QUIT 

 +5       ;

BPS25     ; Update file 9002313.25

 +1        NEW CNT,DA,DIE,DR,LINE,DATA,ENTRY,NUM,NAME,X

 +2        DO MES^XPDUTL("   - Updating BPS NCPDP CLARIFICATION CODES")

 +3        SET CNT=0

 +4        FOR LINE=1:1

               SET DATA=$PIECE($TEXT(BPS25CDS+LINE),";;",2,99)

               if DATA=""

                   QUIT 

               Begin DoDot:1

 +5                SET NUM=$PIECE(DATA,";",1)

 +6                SET NAME=$PIECE(DATA,";",2)

 +7                SET DIE=9002313.25

 +8                SET DA=$ORDER(^BPS(DIE,"B",NUM,""))

 +9                IF 'DA

                       DO MES^XPDUTL("     - No IEN found for entry "_NUM)

                       QUIT 

 +10               SET DR=".02////^S X=NAME"

 +11               DO ^DIE

 +12               SET CNT=CNT+1

 +13               QUIT 

               End DoDot:1

 +14       SET ENTRY="entries"

 +15       IF CNT=1

               SET ENTRY="entry"

 +16       DO MES^XPDUTL("     - "_CNT_" "_ENTRY_" updated")

 +17       DO MES^XPDUTL("   - Done with BPS NCPDP CLARIFICATION CODES")

 +18       DO MES^XPDUTL(" ")

 +19       QUIT 

 +20      ;

BPS25CDS  ; Updated clarification code

 +1       ;;6;CONTINUATION DOSE AFTER STARTER DOSE

 +2       ;;

 +3       ;

 +4        QUIT 

 +5       ;

BPS93     ; Update file 9002313.93

 +1        NEW CNT,DA,DIE,DR,LINE,DATA,NUM,NAME,X

 +2        DO MES^XPDUTL("   - Updating BPS NCPDP REJECT CODES")

 +3        SET CNT=0

 +4        FOR LINE=1:1

               SET DATA=$PIECE($TEXT(BPS93CDS+LINE),";;",2,99)

               if DATA=""

                   QUIT 

               Begin DoDot:1

 +5                SET NUM=$PIECE(DATA,";",1)

 +6                SET NAME=$PIECE(DATA,";",2)

 +7                SET DIE=9002313.93

 +8                SET DA=$ORDER(^BPSF(DIE,"B",NUM,""))

 +9                IF 'DA

                       DO MES^XPDUTL("     - No IEN found for entry "_NUM)

                       QUIT 

 +10               SET DR=".02////^S X=NAME"

 +11               DO ^DIE

 +12               SET CNT=CNT+1

 +13               QUIT 

               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      ;

BPS93CDS  ; Updated reject explanation

 +1       ;;362;Patient Pay Amount Reported is not used for this Transaction Code

 +2       ;;DO1;Beneficiary is not a participant in this Medicare Rx Payment Plan

 +3       ;;DX;M/I Patient Pay Amount Reported

 +4       ;;

 +5       ;

 +6        QUIT