BPS35PRE.m

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 ---BPS35PRE   1229     printed  Apr 09, 2024@20:58:15                                                                                                                                                                                                    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      ;