- 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 Mar 13, 2025@21:28:51 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
