- 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
