DGUTQ.m

DGUTQ ;ALB/AAS - QUEUEING UTILITY (%ZTLOAD) ; 16-JUL-2003

 ;;5.3;Registration;**539,1015**;Aug 13, 1993;Build 21

 ;IHS/ANMC/LJF 11/15/2000 added code to handle default printers

 ;

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  I $D(BDGDEV) S %ZIS("B")=BDGDEV K BDGDEV  ;IHS/ANMC/LJF 11/15/2000

 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

DGUTQ     ;ALB/AAS - QUEUEING UTILITY (%ZTLOAD) ; 16-JUL-2003

 +1       ;;5.3;Registration;**539,1015**;Aug 13, 1993;Build 21

 +2       ;IHS/ANMC/LJF 11/15/2000 added code to handle default printers

 +3       ;

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       ;IHS/ANMC/LJF 11/15/2000

           IF $DATA(BDGDEV)

               SET %ZIS("B")=BDGDEV

               KILL BDGDEV

 +1        WRITE !

           KILL IOP,IO("Q")

           SET POP=0

           SET %ZIS="QMP"

           IF $DATA(DGFZIS)

               SET IOP="Q"

 +2        DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               QUIT 

           IF $DATA(IO("Q"))

               DO QUE

               SET POP=1

               GOTO CLOSE

 +3        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