DGUTQ ;ALB/AAS - QUEUEING UTILITY (%ZTLOAD) ; 16-JUL-2003
;;5.3;Registration;**539**;Aug 13, 1993
;
Q1 S ZTDTH=$H
QUE K IO("Q") I '$D(ZTIO),$D(ION),ION="" S ZTIO=""
I '$D(ZTDESC) S ZTDESC=$S($D(DGPGM):DGPGM,$D(PGM):PGM,1:"MAS UNKNOWN OPTION")
I '$D(ZTRTN) S DGPGM=$S($D(DGPGM):DGPGM,$D(PGM):PGM,1:"") G:DGPGM="" CLOSE S ZTRTN="DQ^DGUTQ"
S DGZTSAVE=$S($D(DGVAR):DGVAR,$D(VAR):VAR,1:"*") D SAVE
I $D(DGPGM),'$D(ZTSAVE("DGPGM")) S ZTSAVE("DGPGM")=""
LOAD D ^%ZTLOAD W:'$D(DGUTQND) !!,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!") S:'$D(ZTSK) X="^" S:$D(ZTSK) X="" G CLOSE:$D(ZTSK),END
Q
ZIS W ! K IOP,IO("Q") S POP=0,%ZIS="QMP" S:$D(DGFZIS) IOP="Q"
D ^%ZIS K %ZIS,IOP Q:POP I $D(IO("Q")) D QUE S POP=1 G CLOSE
U IO Q
SAVE D:DGZTSAVE["#" ARRAY F DGI=1:1 S DGVAR=$P(DGZTSAVE,"^",DGI) Q:DGVAR']"" I '$D(ZTSAVE(DGVAR)) S ZTSAVE(DGVAR)="" S:$E(DGVAR,$L(DGVAR))="(" ZTSAVE($E(DGVAR,1,($L(DGVAR)-1)))=""
Q
ARRAY F DGJ=1:1:$L(DGZTSAVE) I $E(DGZTSAVE,DGJ)="#" S DGZTSAVE=$E(DGZTSAVE,1,(DGJ-1))_"("_$E(DGZTSAVE,DGJ+1,$L(DGZTSAVE))
Q
CLOSE Q:$D(ZTQUEUED) N POP D ^%ZISC
END K ZTSK,ZTDESC,ZTRTN,ZTREQ,ZTSAVE,ZTIO,ZTDTH,ZTUCI,DGUTQND,DGVAR,VAR,DGPGM,PGM,DGZTSAVE,DGI,IO("Q"),IO("C")
Q
DQ D @($S($D(DGPGM):DGPGM,$D(PGM):PGM,1:"CLOSE"))
D KILL^%ZTLOAD,CLOSE
Q
DTQ I $D(ZTSK("D")) S DGX=ZTSK("D"),%H=$P(DGX,",") D YMD^%DTC S DGX=$P(DGX,",",2),Z=X_((DGX#3600\60)/100+(DGX\3600)/100) ;Find time queued
Q
FZIS ;Settings for force queuing
N DGFZIS
S DGFZIS=1 G ZIS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGUTQ 1499 printed Oct 16, 2024@18:59:43 Page 2
DGUTQ ;ALB/AAS - QUEUEING UTILITY (%ZTLOAD) ; 16-JUL-2003
+1 ;;5.3;Registration;**539**;Aug 13, 1993
+2 ;
Q1 SET ZTDTH=$HOROLOG
QUE KILL IO("Q")
IF '$DATA(ZTIO)
IF $DATA(ION)
IF ION=""
SET ZTIO=""
+1 IF '$DATA(ZTDESC)
SET ZTDESC=$SELECT($DATA(DGPGM):DGPGM,$DATA(PGM):PGM,1:"MAS UNKNOWN OPTION")
+2 IF '$DATA(ZTRTN)
SET DGPGM=$SELECT($DATA(DGPGM):DGPGM,$DATA(PGM):PGM,1:"")
if DGPGM=""
GOTO CLOSE
SET ZTRTN="DQ^DGUTQ"
+3 SET DGZTSAVE=$SELECT($DATA(DGVAR):DGVAR,$DATA(VAR):VAR,1:"*")
DO SAVE
+4 IF $DATA(DGPGM)
IF '$DATA(ZTSAVE("DGPGM"))
SET ZTSAVE("DGPGM")=""
LOAD DO ^%ZTLOAD
if '$DATA(DGUTQND)
WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Cancelled!")
if '$DATA(ZTSK)
SET X="^"
if $DATA(ZTSK)
SET X=""
if $DATA(ZTSK)
GOTO CLOSE
GOTO END
+1 QUIT
ZIS WRITE !
KILL IOP,IO("Q")
SET POP=0
SET %ZIS="QMP"
if $DATA(DGFZIS)
SET IOP="Q"
+1 DO ^%ZIS
KILL %ZIS,IOP
if POP
QUIT
IF $DATA(IO("Q"))
DO QUE
SET POP=1
GOTO CLOSE
+2 USE IO
QUIT
SAVE if DGZTSAVE["#"
DO ARRAY
FOR DGI=1:1
SET DGVAR=$PIECE(DGZTSAVE,"^",DGI)
if DGVAR']""
QUIT
IF '$DATA(ZTSAVE(DGVAR))
SET ZTSAVE(DGVAR)=""
if $EXTRACT(DGVAR,$LENGTH(DGVAR))="("
SET ZTSAVE($EXTRACT(DGVAR,1,($LENGTH(DGVAR)-1)))=""
+1 QUIT
ARRAY FOR DGJ=1:1:$LENGTH(DGZTSAVE)
IF $EXTRACT(DGZTSAVE,DGJ)="#"
SET DGZTSAVE=$EXTRACT(DGZTSAVE,1,(DGJ-1))_"("_$EXTRACT(DGZTSAVE,DGJ+1,$LENGTH(DGZTSAVE))
+1 QUIT
CLOSE if $DATA(ZTQUEUED)
QUIT
NEW POP
DO ^%ZISC
END KILL ZTSK,ZTDESC,ZTRTN,ZTREQ,ZTSAVE,ZTIO,ZTDTH,ZTUCI,DGUTQND,DGVAR,VAR,DGPGM,PGM,DGZTSAVE,DGI,IO("Q"),IO("C")
+1 QUIT
DQ DO @($SELECT($DATA(DGPGM):DGPGM,$DATA(PGM):PGM,1:"CLOSE"))
+1 DO KILL^%ZTLOAD
DO CLOSE
+2 QUIT
DTQ ;Find time queued
IF $DATA(ZTSK("D"))
SET DGX=ZTSK("D")
SET %H=$PIECE(DGX,",")
DO YMD^%DTC
SET DGX=$PIECE(DGX,",",2)
SET Z=X_((DGX#3600\60)/100+(DGX\3600)/100)
+1 QUIT
FZIS ;Settings for force queuing
+1 NEW DGFZIS
+2 SET DGFZIS=1
GOTO ZIS
