- 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
