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 ---[H[J[2J[HBPS38PRE 2788 printed Dec 13, 2024@01:50:41 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
