- DGJUTQ ;ALB/MRY - QUEUING UTILITY (%ZTLOAD) ; 23-AUG-2001
- ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- ;
- 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:"IRT UNKNOWN OPTION")
- I '$D(ZTRTN) S DGPGM=$S($D(DGPGM):DGPGM,$D(PGM):PGM,1:"") G:DGPGM="" CLOSE S ZTRTN="DQ^DGJUTQ"
- 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" 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJUTQ 1422 printed Feb 18, 2025@23:27:24 Page 2
- DGJUTQ ;ALB/MRY - QUEUING UTILITY (%ZTLOAD) ; 23-AUG-2001
- +1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- +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:"IRT UNKNOWN OPTION")
- +2 IF '$DATA(ZTRTN)
- SET DGPGM=$SELECT($DATA(DGPGM):DGPGM,$DATA(PGM):PGM,1:"")
- if DGPGM=""
- GOTO CLOSE
- SET ZTRTN="DQ^DGJUTQ"
- +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"
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- QUIT
- IF $DATA(IO("Q"))
- DO QUE
- SET POP=1
- GOTO CLOSE
- +1 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