PSO7P341 ;BAY PINES-CIOFO/TN - Patch 341 Post Install routine;9/9/09 5:06pm ; 10/22/09 10:50am
;;7.0;OUTPATIENT PHARMACY;**341**;DEC 1997;Build 8
;
NEW ZTIO,ZTRTN,ZTDESC
S ZTIO="",ZTRTN="START^PSO7P341",ZTDESC="PSO*7*341 post-int process"
D ^%ZTLOAD
W !!,$S($D(ZTSK):"PSO*7*341 post-init has been queued - Task number ")
W ZTSK KILL ZTSK
QUIT
;
;--------------------------------------------------------------
START KILL ^TMP("PSO7P341")
;
S ^TMP("PSO7P341")="0^0"
S IEN=0
;
START1 I $G(RESTART) S IEN=$P($G(^TMP("PSO7P341")),U)
;
F S IEN=$O(^PSRX(IEN)) Q:'IEN D
. S REFILL=0,$P(^TMP("PSO7P341"),U)=IEN
. S RX=$P($G(^PSRX(IEN,0)),U) I RX="" Q
. F S REFILL=$O(^PSRX(IEN,1,REFILL)) Q:'REFILL D
. . ;
. . ;Check "EPH" Node
. . I $D(^PSRX(IEN,1,REFILL,"EPH")),'$D(^PSRX(IEN,1,REFILL,0)) D
. . . KILL ^PSRX(IEN,1,REFILL,"EPH")
. . . S $P(^TMP("PSO7P341"),U,2)=$P(^TMP("PSO7P341"),U,2)+1
. . . S ^TMP("PSO7P341",RX,REFILL)=""
;
D EMAIL:$G(DUZ)
;
KILL IEN,REFILL,RESTART,^TMP("PSO7P341")
QUIT
;-------------------------------------------------------------
EMAIL NEW XMSUB,XMTEXT,XMY,XMDUZ,PSOMSG,PSONAME,PSOCNT,PSOCNT1
NEW PSOIEN,PSOFILL S PSOIEN=""
S PSONAME="PSO*7*341 Post-Init"
S PSOMSG(1)=PSONAME_" has completed"
S PSOMSG(2)="Number of invalid EPH nodes killed is "
S PSOMSG(2)=PSOMSG(2)_$P($G(^TMP("PSO7P341")),U,2)
S PSOMSG(3)=" "
S XMSUB=PSONAME
S XMDUZ="OUTPATIENT PHARMACY"
S XMTEXT="PSOMSG("
S XMY(DUZ)=""
S PSOCNT=0,PSOCNT1=4
F S PSOIEN=$O(^TMP("PSO7P341",PSOIEN)) Q:PSOIEN="" D
. S PSOFILL=""
. F S PSOFILL=$O(^TMP("PSO7P341",PSOIEN,PSOFILL)) Q:PSOFILL="" D
. . S PSOCNT1=PSOCNT1+1,PSOCNT=PSOCNT+1
. . S PSOMSG(PSOCNT1)=$E(100000+PSOCNT,2,99)
. . S PSOMSG(PSOCNT1)=PSOMSG(PSOCNT1)_" RX:"_PSOIEN_" "
. . S PSOMSG(PSOCNT1)=PSOMSG(PSOCNT1)_"INVALID FILL#:"_PSOFILL
D ^XMD
Q
;-------------------------------------------------------------
RESTART NEW ZTSAVE,ZTIO,ZTRTN,ZTDESC
S ZTSAVE("RESTART")=1
S ZTIO="",ZTRTN="START1^PSO7P341",ZTDESC="PSO*7*341 Post-init"
D ^%ZTLOAD
W !!,$S($D(ZTSK):"PSO*7*341 post-init (RESTARTED) - Task number ")
W ZTSK KILL ZTSK
Q
;
TEST ;Create entries and stop compile to test restart
;Call routine at RESTART^PSO7P341 to restart
;This subroutine is for testing only
;
NEW STOP,IEN,REFILL,RX
KILL ^TMP("PSO7P341")
S ^TMP("PSO7P341")="0^0"
S IEN=0
F S IEN=$O(^PSRX(IEN)) Q:'IEN Q:$G(STOP) D
. S REFILL=0,$P(^TMP("PSO7P341"),U)=IEN
. S RX=$P($G(^PSRX(IEN,0)),U) I RX="" Q
. F S REFILL=$O(^PSRX(IEN,1,REFILL)) Q:'REFILL D
. . S $P(^TMP("PSO7P341"),U,2)=$P(^TMP("PSO7P341"),U,2)+1
. . S ^TMP("PSO7P341",RX,REFILL)=""
. . I $P($G(^TMP("PSO7P341")),U,2)>12 S STOP=1
I $G(STOP) D
. W !,"Test compile completed."
. W !,"Type D RESTART^PSO7P341 to test restart",!
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P341 2917 printed Sep 23, 2025@19:59:58 Page 2
PSO7P341 ;BAY PINES-CIOFO/TN - Patch 341 Post Install routine;9/9/09 5:06pm ; 10/22/09 10:50am
+1 ;;7.0;OUTPATIENT PHARMACY;**341**;DEC 1997;Build 8
+2 ;
+3 NEW ZTIO,ZTRTN,ZTDESC
+4 SET ZTIO=""
SET ZTRTN="START^PSO7P341"
SET ZTDESC="PSO*7*341 post-int process"
+5 DO ^%ZTLOAD
+6 WRITE !!,$SELECT($DATA(ZTSK):"PSO*7*341 post-init has been queued - Task number ")
+7 WRITE ZTSK
KILL ZTSK
+8 QUIT
+9 ;
+10 ;--------------------------------------------------------------
START KILL ^TMP("PSO7P341")
+1 ;
+2 SET ^TMP("PSO7P341")="0^0"
+3 SET IEN=0
+4 ;
START1 IF $GET(RESTART)
SET IEN=$PIECE($GET(^TMP("PSO7P341")),U)
+1 ;
+2 FOR
SET IEN=$ORDER(^PSRX(IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET REFILL=0
SET $PIECE(^TMP("PSO7P341"),U)=IEN
+4 SET RX=$PIECE($GET(^PSRX(IEN,0)),U)
IF RX=""
QUIT
+5 FOR
SET REFILL=$ORDER(^PSRX(IEN,1,REFILL))
if 'REFILL
QUIT
Begin DoDot:2
+6 ;
+7 ;Check "EPH" Node
+8 IF $DATA(^PSRX(IEN,1,REFILL,"EPH"))
IF '$DATA(^PSRX(IEN,1,REFILL,0))
Begin DoDot:3
+9 KILL ^PSRX(IEN,1,REFILL,"EPH")
+10 SET $PIECE(^TMP("PSO7P341"),U,2)=$PIECE(^TMP("PSO7P341"),U,2)+1
+11 SET ^TMP("PSO7P341",RX,REFILL)=""
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
+13 if $GET(DUZ)
DO EMAIL
+14 ;
+15 KILL IEN,REFILL,RESTART,^TMP("PSO7P341")
+16 QUIT
+17 ;-------------------------------------------------------------
EMAIL NEW XMSUB,XMTEXT,XMY,XMDUZ,PSOMSG,PSONAME,PSOCNT,PSOCNT1
+1 NEW PSOIEN,PSOFILL
SET PSOIEN=""
+2 SET PSONAME="PSO*7*341 Post-Init"
+3 SET PSOMSG(1)=PSONAME_" has completed"
+4 SET PSOMSG(2)="Number of invalid EPH nodes killed is "
+5 SET PSOMSG(2)=PSOMSG(2)_$PIECE($GET(^TMP("PSO7P341")),U,2)
+6 SET PSOMSG(3)=" "
+7 SET XMSUB=PSONAME
+8 SET XMDUZ="OUTPATIENT PHARMACY"
+9 SET XMTEXT="PSOMSG("
+10 SET XMY(DUZ)=""
+11 SET PSOCNT=0
SET PSOCNT1=4
+12 FOR
SET PSOIEN=$ORDER(^TMP("PSO7P341",PSOIEN))
if PSOIEN=""
QUIT
Begin DoDot:1
+13 SET PSOFILL=""
+14 FOR
SET PSOFILL=$ORDER(^TMP("PSO7P341",PSOIEN,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:2
+15 SET PSOCNT1=PSOCNT1+1
SET PSOCNT=PSOCNT+1
+16 SET PSOMSG(PSOCNT1)=$EXTRACT(100000+PSOCNT,2,99)
+17 SET PSOMSG(PSOCNT1)=PSOMSG(PSOCNT1)_" RX:"_PSOIEN_" "
+18 SET PSOMSG(PSOCNT1)=PSOMSG(PSOCNT1)_"INVALID FILL#:"_PSOFILL
End DoDot:2
End DoDot:1
+19 DO ^XMD
+20 QUIT
+21 ;-------------------------------------------------------------
RESTART NEW ZTSAVE,ZTIO,ZTRTN,ZTDESC
+1 SET ZTSAVE("RESTART")=1
+2 SET ZTIO=""
SET ZTRTN="START1^PSO7P341"
SET ZTDESC="PSO*7*341 Post-init"
+3 DO ^%ZTLOAD
+4 WRITE !!,$SELECT($DATA(ZTSK):"PSO*7*341 post-init (RESTARTED) - Task number ")
+5 WRITE ZTSK
KILL ZTSK
+6 QUIT
+7 ;
TEST ;Create entries and stop compile to test restart
+1 ;Call routine at RESTART^PSO7P341 to restart
+2 ;This subroutine is for testing only
+3 ;
+4 NEW STOP,IEN,REFILL,RX
+5 KILL ^TMP("PSO7P341")
+6 SET ^TMP("PSO7P341")="0^0"
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(^PSRX(IEN))
if 'IEN
QUIT
if $GET(STOP)
QUIT
Begin DoDot:1
+9 SET REFILL=0
SET $PIECE(^TMP("PSO7P341"),U)=IEN
+10 SET RX=$PIECE($GET(^PSRX(IEN,0)),U)
IF RX=""
QUIT
+11 FOR
SET REFILL=$ORDER(^PSRX(IEN,1,REFILL))
if 'REFILL
QUIT
Begin DoDot:2
+12 SET $PIECE(^TMP("PSO7P341"),U,2)=$PIECE(^TMP("PSO7P341"),U,2)+1
+13 SET ^TMP("PSO7P341",RX,REFILL)=""
+14 IF $PIECE($GET(^TMP("PSO7P341")),U,2)>12
SET STOP=1
End DoDot:2
End DoDot:1
+15 IF $GET(STOP)
Begin DoDot:1
+16 WRITE !,"Test compile completed."
+17 WRITE !,"Type D RESTART^PSO7P341 to test restart",!
End DoDot:1
+18 QUIT
