PSO7P667.m

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 ---PSO7P667   1495     printed  Apr 09, 2024@21:34:57                                                                                                                                                                                                    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