PSO160EN ;BIR/MR-Patch 160 Environment Check routine ;11/27/03
;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
;External reference to ^ORD(101, is supp. by DBIA# 872
;
N RXSTS,DIR,SDPRTCL,PSOPRTCL,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
;
;- Looking for 'NON-VA' entry in the RX PATIENT STATUS file (#53)
S XPDABORT=2
S RXSTS="" F S RXSTS=$O(^PS(53,"B",RXSTS)) Q:RXSTS="" D I 'XPDABORT Q
. I $$UP^XLFSTR(RXSTS)="NON-VA" S XPDABORT=0 Q
;
I XPDABORT D S XPDABORT=2 Q
. W !!,"The RX PATIENT STATUS File (#53) named 'NON-VA' was not found."
. W !,"It must be created before this patch can be installed.",!
. K DIR S DIR(0)="E",DIR("A")="Press Return to Continue"
. D ^DIR K DIR
;
;- Checking existence of SD Event Protocol SDAM APPOINTMENT EVENTS
S SDPRTCL=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",""))
I 'SDPRTCL D S XPDABORT=2 Q
. W !!,"The Scheduling Event Protocol SDAM APPOINTMENT EVENTS was not found."
. W !,"This protocol must be present before this patch can be installed.",!
. K DIR S DIR(0)="E",DIR("A")="Press Return to Continue"
. D ^DIR K DIR
;
S PSOPRTCL=$O(^ORD(101,"B","PSO TPB SD SUB",""))
I 'PSOPRTCL D
. N DIC S X="PSO TPB SD SUB",DIC="^ORD(101,",DLAYGO=101,DIC(0)="L"
. S DIC("DR")="4///A"
. D FILE^DICN Q:$G(Y)<0 S PSOPRTCL=+Y
. S ^ORD(101,PSOPRTCL,20)="EN^PSOTPINA"
;
I 'PSOPRTCL D S XPDABORT=2 Q
. W !!,"The new protocol PSO TPB SD SUB could not be created."
. W !,"The installation of this patch will be aborted.",!
. K DIR S DIR(0)="E",DIR("A")="Press Return to Continue"
. D ^DIR K DIR
;
I '$D(^ORD(101,SDPRTCL,10,"B",PSOPRTCL)) D
. N DIC S X=PSOPRTCL,DIC="^ORD(101,"_SDPRTCL_",10,",DLAYGO=101.01
. S DA(1)=SDPRTCL,DIC(0)="L" D FILE^DICN I $G(Y)<0 S XPDABORT=2
;
I XPDABORT D Q
. W !!,"The new Outpatient Pharmacy Protocol PSO TPB SD SUB could not be added as a subscriber"
. W !,"to the Scheduling Event Protocol SDAM APPOINTMENT EVENTS. The installation of this patch"
. W !,"will be aborted.",!
. K DIR S DIR(0)="E",DIR("A")="Press Return to Continue"
. D ^DIR K DIR
;
Q:'$G(XPDENV)
W ! K %DT D NOW^%DTC S %DT="RAEX",%DT(0)=%,%DT("A")="Queue the Post-Install to run at what Date@Time: "
D ^%DT K %DT I $D(DTOUT)!(Y<0) W !!,"Cannot install the patch without queuing the post-install, install aborted!",! S XPDABORT=2 Q
S @XPDGREF@("PSO160Q")=Y,@XPDGREF@("PSOUSER")=DUZ
Q
PSO160EN ;BIR/MR-Patch 160 Environment Check routine ;11/27/03
+1 ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
+2 ;External reference to ^ORD(101, is supp. by DBIA# 872
+3 ;
+4 NEW RXSTS,DIR,SDPRTCL,PSOPRTCL,X,DIC,DA,DLAYGO,DD,DO,DINUM,Y
+5 ;
+6 ;- Looking for 'NON-VA' entry in the RX PATIENT STATUS file (#53)
+7 SET XPDABORT=2
+8 SET RXSTS=""
FOR
SET RXSTS=$ORDER(^PS(53,"B",RXSTS))
IF RXSTS=""
QUIT
Begin DoDot:1
+9 IF $$UP^XLFSTR(RXSTS)="NON-VA"
SET XPDABORT=0
QUIT
End DoDot:1
IF 'XPDABORT
QUIT
+10 ;
+11 IF XPDABORT
Begin DoDot:1
+12 WRITE !!,"The RX PATIENT STATUS File (#53) named 'NON-VA' was not found."
+13 WRITE !,"It must be created before this patch can be installed.",!
+14 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
+15 DO ^DIR
KILL DIR
End DoDot:1
SET XPDABORT=2
QUIT
+16 ;
+17 ;- Checking existence of SD Event Protocol SDAM APPOINTMENT EVENTS
+18 SET SDPRTCL=$ORDER(^ORD(101,"B","SDAM APPOINTMENT EVENTS",""))
+19 IF 'SDPRTCL
Begin DoDot:1
+20 WRITE !!,"The Scheduling Event Protocol SDAM APPOINTMENT EVENTS was not found."
+21 WRITE !,"This protocol must be present before this patch can be installed.",!
+22 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
+23 DO ^DIR
KILL DIR
End DoDot:1
SET XPDABORT=2
QUIT
+24 ;
+25 SET PSOPRTCL=$ORDER(^ORD(101,"B","PSO TPB SD SUB",""))
+26 IF 'PSOPRTCL
Begin DoDot:1
+27 NEW DIC
SET X="PSO TPB SD SUB"
SET DIC="^ORD(101,"
SET DLAYGO=101
SET DIC(0)="L"
+28 SET DIC("DR")="4///A"
+29 DO FILE^DICN
IF $GET(Y)<0
QUIT
SET PSOPRTCL=+Y
+30 SET ^ORD(101,PSOPRTCL,20)="EN^PSOTPINA"
End DoDot:1
+31 ;
+32 IF 'PSOPRTCL
Begin DoDot:1
+33 WRITE !!,"The new protocol PSO TPB SD SUB could not be created."
+34 WRITE !,"The installation of this patch will be aborted.",!
+35 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
+36 DO ^DIR
KILL DIR
End DoDot:1
SET XPDABORT=2
QUIT
+37 ;
+38 IF '$DATA(^ORD(101,SDPRTCL,10,"B",PSOPRTCL))
Begin DoDot:1
+39 NEW DIC
SET X=PSOPRTCL
SET DIC="^ORD(101,"_SDPRTCL_",10,"
SET DLAYGO=101.01
+40 SET DA(1)=SDPRTCL
SET DIC(0)="L"
DO FILE^DICN
IF $GET(Y)<0
SET XPDABORT=2
End DoDot:1
+41 ;
+42 IF XPDABORT
Begin DoDot:1
+43 WRITE !!,"The new Outpatient Pharmacy Protocol PSO TPB SD SUB could not be added as a subscriber"
+44 WRITE !,"to the Scheduling Event Protocol SDAM APPOINTMENT EVENTS. The installation of this patch"
+45 WRITE !,"will be aborted.",!
+46 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
+47 DO ^DIR
KILL DIR
End DoDot:1
QUIT
+48 ;
+49 IF '$GET(XPDENV)
QUIT
+50 WRITE !
KILL %DT
DO NOW^%DTC
SET %DT="RAEX"
SET %DT(0)=%
SET %DT("A")="Queue the Post-Install to run at what Date@Time: "
+51 DO ^%DT
KILL %DT
IF $DATA(DTOUT)!(Y<0)
WRITE !!,"Cannot install the patch without queuing the post-install, install aborted!",!
SET XPDABORT=2
QUIT
+52 SET @XPDGREF@("PSO160Q")=Y
SET @XPDGREF@("PSOUSER")=DUZ
+53 QUIT