PSO7P667 ;DAL/MHA - Post Install routine for patch PSO*7*667 ;12/30/2021
;;7.0;OUTPATIENT PHARMACY;**667**;DEC 1997;Build 18
Q
EN ;
;D PUT^XPAR("SYS","PSOEPCS EXPIRED DEA FAILOVER",1,1)
;
N BY,ENTRY,ERR,ROOT,WHEN,DUZ
N DIFROM
S DUZ=.5
;
; Check to see if PSO EPCS PSDRPH AUDIT is already scheduled.
K ROOT D OPTSTAT^XUTMOPT("PSO EPCS PSDRPH AUDIT",.ROOT)
I $D(ROOT(1)),$P(ROOT(1),"^",2)'="",$P(ROOT(1),"^",3)'="" G CONT1
;
; Change from XU EPCS PSDRPH AUDIT to PSO EPCS PSDRPH AUDIT
K ROOT D OPTSTAT^XUTMOPT("XU EPCS PSDRPH AUDIT",.ROOT)
I $D(ROOT(1)) F ENTRY=1:1:ROOT D
. I $P(ROOT(ENTRY),"^",2)="" Q
. I $P(ROOT(ENTRY),"^",3)="" Q
. S WHEN=$P(ROOT(ENTRY),"^",2),BY=$P(ROOT(ENTRY),"^",3)
. D RESCH^XUTMOPT("PSO EPCS PSDRPH AUDIT",WHEN,"",BY,"L",.ERR)
. D RESCH^XUTMOPT("XU EPCS PSDRPH AUDIT","@","","@","",.ERR)
CONT1 ;
;
; Check to see if PSO EPCS LOGICAL ACCESS is already scheduled.
K ROOT D OPTSTAT^XUTMOPT("PSO EPCS LOGICAL ACCESS",.ROOT)
I $D(ROOT(1)),$P(ROOT(1),"^",2)'="",$P(ROOT(1),"^",3)'="" G CONT2
;
; Change from XU EPCS LOGICAL ACCESS to PSO EPCS LOGICAL ACCESS
K ROOT D OPTSTAT^XUTMOPT("XU EPCS LOGICAL ACCESS",.ROOT)
I $D(ROOT(1)) F ENTRY=1:1:ROOT D
. I $P(ROOT(ENTRY),"^",2)="" Q
. I $P(ROOT(ENTRY),"^",3)="" Q
. S WHEN=$P(ROOT(ENTRY),"^",2),BY=$P(ROOT(ENTRY),"^",3)
. D RESCH^XUTMOPT("PSO EPCS LOGICAL ACCESS",WHEN,"",BY,"L",.ERR)
. D RESCH^XUTMOPT("XU EPCS LOGICAL ACCESS","@","","@","",.ERR)
CONT2 ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P667 1495 printed Nov 22, 2024@17:33:58 Page 2
PSO7P667 ;DAL/MHA - Post Install routine for patch PSO*7*667 ;12/30/2021
+1 ;;7.0;OUTPATIENT PHARMACY;**667**;DEC 1997;Build 18
+2 QUIT
EN ;
+1 ;D PUT^XPAR("SYS","PSOEPCS EXPIRED DEA FAILOVER",1,1)
+2 ;
+3 NEW BY,ENTRY,ERR,ROOT,WHEN,DUZ
+4 NEW DIFROM
+5 SET DUZ=.5
+6 ;
+7 ; Check to see if PSO EPCS PSDRPH AUDIT is already scheduled.
+8 KILL ROOT
DO OPTSTAT^XUTMOPT("PSO EPCS PSDRPH AUDIT",.ROOT)
+9 IF $DATA(ROOT(1))
IF $PIECE(ROOT(1),"^",2)'=""
IF $PIECE(ROOT(1),"^",3)'=""
GOTO CONT1
+10 ;
+11 ; Change from XU EPCS PSDRPH AUDIT to PSO EPCS PSDRPH AUDIT
+12 KILL ROOT
DO OPTSTAT^XUTMOPT("XU EPCS PSDRPH AUDIT",.ROOT)
+13 IF $DATA(ROOT(1))
FOR ENTRY=1:1:ROOT
Begin DoDot:1
+14 IF $PIECE(ROOT(ENTRY),"^",2)=""
QUIT
+15 IF $PIECE(ROOT(ENTRY),"^",3)=""
QUIT
+16 SET WHEN=$PIECE(ROOT(ENTRY),"^",2)
SET BY=$PIECE(ROOT(ENTRY),"^",3)
+17 DO RESCH^XUTMOPT("PSO EPCS PSDRPH AUDIT",WHEN,"",BY,"L",.ERR)
+18 DO RESCH^XUTMOPT("XU EPCS PSDRPH AUDIT","@","","@","",.ERR)
End DoDot:1
CONT1 ;
+1 ;
+2 ; Check to see if PSO EPCS LOGICAL ACCESS is already scheduled.
+3 KILL ROOT
DO OPTSTAT^XUTMOPT("PSO EPCS LOGICAL ACCESS",.ROOT)
+4 IF $DATA(ROOT(1))
IF $PIECE(ROOT(1),"^",2)'=""
IF $PIECE(ROOT(1),"^",3)'=""
GOTO CONT2
+5 ;
+6 ; Change from XU EPCS LOGICAL ACCESS to PSO EPCS LOGICAL ACCESS
+7 KILL ROOT
DO OPTSTAT^XUTMOPT("XU EPCS LOGICAL ACCESS",.ROOT)
+8 IF $DATA(ROOT(1))
FOR ENTRY=1:1:ROOT
Begin DoDot:1
+9 IF $PIECE(ROOT(ENTRY),"^",2)=""
QUIT
+10 IF $PIECE(ROOT(ENTRY),"^",3)=""
QUIT
+11 SET WHEN=$PIECE(ROOT(ENTRY),"^",2)
SET BY=$PIECE(ROOT(ENTRY),"^",3)
+12 DO RESCH^XUTMOPT("PSO EPCS LOGICAL ACCESS",WHEN,"",BY,"L",.ERR)
+13 DO RESCH^XUTMOPT("XU EPCS LOGICAL ACCESS","@","","@","",.ERR)
End DoDot:1
CONT2 ;
+1 QUIT
