BPS35PRE ;AITC/PED - Pre-install routine for BPS*1*35 ;01/2023
;;1.0;E CLAIMS MGMT ENGINE;**35**;JUN 2004;Build 14
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF EDI TAS ePharmacy - BPS*1*35 patch pre-install
;
Q
;
PRE ; Entry Point for pre-install
;
D MES^XPDUTL(" Starting pre-install for BPS*1*35")
;
D BPS21
D BPS42
D BPS93
;
D MES^XPDUTL(" Finished pre-install of BPS*1*35")
;
Q
;
BPS21 ; Update File 9002313.21
;
N BPSA,BPSFN,BPSID,BPSREC
;
S BPSID=$O(^BPS(9002313.21,"B","NM",""))
I BPSID="" Q
S BPSFN=9002313.21
S BPSREC=BPSID_","
S BPSA(BPSFN,BPSREC,1)="Non-Medication Counseling"
D FILE^DIE("","BPSA","")
;
Q
;
BPS42 ; Update File 9002313.42
;
N BPSA,BPSFN,BPSID,BPSREC
;
S BPSID=$O(^BPS(9002313.42,"B","07",""))
I BPSID="" Q
S BPSFN=9002313.42
S BPSREC=BPSID_","
S BPSA(BPSFN,BPSREC,.02)="DEA - Active Controlled Substances Act (CSA)"
D FILE^DIE("","BPSA","")
;
Q
;
BPS93 ; Update File 9002313.93
;
N BPSA,BPSFN,BPSID,BPSREC
;
S BPSID=$O(^BPSF(9002313.93,"B","Yes",""))
I BPSID="" Q
S BPSFN=9002313.93
S BPSREC=BPSID_","
S BPSA(BPSFN,BPSREC,.01)="@"
D FILE^DIE("","BPSA","")
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS35PRE 1229 printed Nov 22, 2024@17:00:50 Page 2
BPS35PRE ;AITC/PED - Pre-install routine for BPS*1*35 ;01/2023
+1 ;;1.0;E CLAIMS MGMT ENGINE;**35**;JUN 2004;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF EDI TAS ePharmacy - BPS*1*35 patch pre-install
+5 ;
+6 QUIT
+7 ;
PRE ; Entry Point for pre-install
+1 ;
+2 DO MES^XPDUTL(" Starting pre-install for BPS*1*35")
+3 ;
+4 DO BPS21
+5 DO BPS42
+6 DO BPS93
+7 ;
+8 DO MES^XPDUTL(" Finished pre-install of BPS*1*35")
+9 ;
+10 QUIT
+11 ;
BPS21 ; Update File 9002313.21
+1 ;
+2 NEW BPSA,BPSFN,BPSID,BPSREC
+3 ;
+4 SET BPSID=$ORDER(^BPS(9002313.21,"B","NM",""))
+5 IF BPSID=""
QUIT
+6 SET BPSFN=9002313.21
+7 SET BPSREC=BPSID_","
+8 SET BPSA(BPSFN,BPSREC,1)="Non-Medication Counseling"
+9 DO FILE^DIE("","BPSA","")
+10 ;
+11 QUIT
+12 ;
BPS42 ; Update File 9002313.42
+1 ;
+2 NEW BPSA,BPSFN,BPSID,BPSREC
+3 ;
+4 SET BPSID=$ORDER(^BPS(9002313.42,"B","07",""))
+5 IF BPSID=""
QUIT
+6 SET BPSFN=9002313.42
+7 SET BPSREC=BPSID_","
+8 SET BPSA(BPSFN,BPSREC,.02)="DEA - Active Controlled Substances Act (CSA)"
+9 DO FILE^DIE("","BPSA","")
+10 ;
+11 QUIT
+12 ;
BPS93 ; Update File 9002313.93
+1 ;
+2 NEW BPSA,BPSFN,BPSID,BPSREC
+3 ;
+4 SET BPSID=$ORDER(^BPSF(9002313.93,"B","Yes",""))
+5 IF BPSID=""
QUIT
+6 SET BPSFN=9002313.93
+7 SET BPSREC=BPSID_","
+8 SET BPSA(BPSFN,BPSREC,.01)="@"
+9 DO FILE^DIE("","BPSA","")
+10 ;
+11 QUIT
+12 ;
