BPS36PRE ;AITC/PED - Pre-install routine for BPS*1*36 ;06/2023
;;1.0;E CLAIMS MGMT ENGINE;**36**;JUN 2004;Build 16
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*36 patch pre-install
;
Q
;
PRE ; Entry Point for pre-install
;
D MES^XPDUTL(" Starting pre-install for BPS*1*36")
;
D BPS21
D BPS23
;
D MES^XPDUTL(" Finished pre-install of BPS*1*36")
;
Q
;
BPS21 ; Update File 9002313.21
;
N BPSA,BPSCD,BPSFN,BPSID,BPSREC
;
; Update Description
S BPSID=$O(^BPS(9002313.21,"B","MB",""))
I BPSID="" Q
S BPSFN=9002313.21
S BPSREC=BPSID_","
S BPSA(BPSFN,BPSREC,1)="MEDICATION BENEFIT OUTWEIGHS RISK"
D FILE^DIE("","BPSA","")
;
; Inactivate Codes
F BPSCD="FE","PH","TC" D
. S BPSID=$O(^BPS(9002313.21,"B",BPSCD,""))
. I BPSID="" Q
. S BPSFN=9002313.21
. S BPSREC=BPSID_","
. S BPSA(BPSFN,BPSREC,2)=1
. D FILE^DIE("","BPSA","")
;
Q
;
BPS23 ; Update File 9002313.23
;
N BPSA,BPSCD,BPSFN,BPSID,BPSREC
;
; Update Description
S BPSID=$O(^BPS(9002313.23,"B","TD",""))
I BPSID="" Q
S BPSFN=9002313.23
S BPSREC=BPSID_","
S BPSA(BPSFN,BPSREC,1)="THERAPEUTIC DUPLICATION"
D FILE^DIE("","BPSA","")
;
; Inactivate Codes
F BPSCD="CH","LK","SD" D
. S BPSID=$O(^BPS(9002313.23,"B",BPSCD,""))
. I BPSID="" Q
. S BPSFN=9002313.23
. S BPSREC=BPSID_","
. S BPSA(BPSFN,BPSREC,2)=1
. D FILE^DIE("","BPSA","")
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS36PRE 1460 printed Sep 15, 2024@21:14:53 Page 2
BPS36PRE ;AITC/PED - Pre-install routine for BPS*1*36 ;06/2023
+1 ;;1.0;E CLAIMS MGMT ENGINE;**36**;JUN 2004;Build 16
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*36 patch pre-install
+5 ;
+6 QUIT
+7 ;
PRE ; Entry Point for pre-install
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install for BPS*1*36")
+3 ;
+4 DO BPS21
+5 DO BPS23
+6 ;
+7 DO MES^XPDUTL(" Finished pre-install of BPS*1*36")
+8 ;
+9 QUIT
+10 ;
BPS21 ; Update File 9002313.21
+1 ;
+2 NEW BPSA,BPSCD,BPSFN,BPSID,BPSREC
+3 ;
+4 ; Update Description
+5 SET BPSID=$ORDER(^BPS(9002313.21,"B","MB",""))
+6 IF BPSID=""
QUIT
+7 SET BPSFN=9002313.21
+8 SET BPSREC=BPSID_","
+9 SET BPSA(BPSFN,BPSREC,1)="MEDICATION BENEFIT OUTWEIGHS RISK"
+10 DO FILE^DIE("","BPSA","")
+11 ;
+12 ; Inactivate Codes
+13 FOR BPSCD="FE","PH","TC"
Begin DoDot:1
+14 SET BPSID=$ORDER(^BPS(9002313.21,"B",BPSCD,""))
+15 IF BPSID=""
QUIT
+16 SET BPSFN=9002313.21
+17 SET BPSREC=BPSID_","
+18 SET BPSA(BPSFN,BPSREC,2)=1
+19 DO FILE^DIE("","BPSA","")
End DoDot:1
+20 ;
+21 QUIT
+22 ;
BPS23 ; Update File 9002313.23
+1 ;
+2 NEW BPSA,BPSCD,BPSFN,BPSID,BPSREC
+3 ;
+4 ; Update Description
+5 SET BPSID=$ORDER(^BPS(9002313.23,"B","TD",""))
+6 IF BPSID=""
QUIT
+7 SET BPSFN=9002313.23
+8 SET BPSREC=BPSID_","
+9 SET BPSA(BPSFN,BPSREC,1)="THERAPEUTIC DUPLICATION"
+10 DO FILE^DIE("","BPSA","")
+11 ;
+12 ; Inactivate Codes
+13 FOR BPSCD="CH","LK","SD"
Begin DoDot:1
+14 SET BPSID=$ORDER(^BPS(9002313.23,"B",BPSCD,""))
+15 IF BPSID=""
QUIT
+16 SET BPSFN=9002313.23
+17 SET BPSREC=BPSID_","
+18 SET BPSA(BPSFN,BPSREC,2)=1
+19 DO FILE^DIE("","BPSA","")
End DoDot:1
+20 ;
+21 QUIT
+22 ;
