- AUQUE ;TRANSFER TO "MGR" AND REMOVE THIS LINE [ 03/12/87 4:01 PM ]
- %AUQUE ;SPECIFY A DEVICE AND SET ^%ZTSK FOR QUE [ 05/29/85 1:58 PM ]
- ;IHS-OKLA CITY AREA OFFICE-LMD
- ;IHS-OHPD-ACC ADDED CALL ON %AUKVAR TO INSURE SETUP OF DUZ(2)
- I $D(IOP) K:IOP'="Q" IOP
- DEVICE K AU("QUE"),AU("PRINT") S %IS="PQ",DTIME=300 W !! D ^%ZIS Q:POP G Q:$D(IO("Q")) S AU("PRINT")="" Q
- Q K IO("Q") R !,"REQUESTED TIME TO PRINT: NOW// ",X Q:X["^" S Y=$H I $P("NOW",X,1)]"" S:X'["@" X="T@"_X S %DT(0)=0,%DT="TXE" D ^%DT K %DT G Q:Y<1 S X=+Y D H^%DTC S Y=Y_"000",Y=%H_","_($E(Y,9,10)*60+$E(Y,11,12)*60)
- S AUQDATE=Y
- D ^%AUKVAR S:'$D(SITENUM) SITENUM=DUZ(2) ; GUARANTEE SITENUM AND DUZ(2)
- S X=AUQDATE L ^%ZTSK S (^%ZTSK(0),ZTSK)=^%ZTSK(0)+1 L X ^%ZOSF("UCI") S ^%ZTSK(ZTSK,0)="^"_DUZ_"^"_Y_"^"_$H,^("ZTSK")=ZTSK,^%ZTSCH(X,ZTSK)=IO,AU("QUE")="" S ^%ZTSK(ZTSK,"SITE")=SITENUM,^("DUZ(2)")=DUZ(2)
- END K AUQDATE Q
- KZTSK ;ENTRY POINT TO KILL ^%ZTSK AND SET ^%ZTSK(0)=1000
- S ^%ZTSK(0)=1000,R=0
- K1 S R=$O(^%ZTSK(R)) Q:R="" K ^%ZTSK(R) G K1
- KZTSCH ;ENTRY POINT TO KILL %ZTSCH FOR SCH BACKUP
- S AU=0
- Z1 S AU=$O(^%ZTSCH(AU)) Q:AU=""!($O(^%ZTSCH(AU,0))'=999) K ^%ZTSCH(AU,999) G Z1
- AUQUE ;TRANSFER TO "MGR" AND REMOVE THIS LINE [ 03/12/87 4:01 PM ]
- %AUQUE ;SPECIFY A DEVICE AND SET ^%ZTSK FOR QUE [ 05/29/85 1:58 PM ]
- +1 ;IHS-OKLA CITY AREA OFFICE-LMD
- +2 ;IHS-OHPD-ACC ADDED CALL ON %AUKVAR TO INSURE SETUP OF DUZ(2)
- +3 IF $DATA(IOP)
- IF IOP'="Q"
- KILL IOP
- DEVICE KILL AU("QUE"),AU("PRINT")
- SET %IS="PQ"
- SET DTIME=300
- WRITE !!
- DO ^%ZIS
- IF POP
- QUIT
- IF $DATA(IO("Q"))
- GOTO Q
- SET AU("PRINT")=""
- QUIT
- Q KILL IO("Q")
- READ !,"REQUESTED TIME TO PRINT: NOW// ",X
- IF X["^"
- QUIT
- SET Y=$HOROLOG
- IF $PIECE("NOW",X,1)]""
- IF X'["@"
- SET X="T@"_X
- SET %DT(0)=0
- SET %DT="TXE"
- DO ^%DT
- KILL %DT
- IF Y<1
- GOTO Q
- SET X=+Y
- DO H^%DTC
- SET Y=Y_"000"
- SET Y=%H_","_($EXTRACT(Y,9,10)*60+$EXTRACT(Y,11,12)*60)
- +1 SET AUQDATE=Y
- +2 ; GUARANTEE SITENUM AND DUZ(2)
- DO ^%AUKVAR
- IF '$DATA(SITENUM)
- SET SITENUM=DUZ(2)
- +3 SET X=AUQDATE
- LOCK ^%ZTSK
- SET (^%ZTSK(0),ZTSK)=^%ZTSK(0)+1
- LOCK
- XECUTE ^%ZOSF("UCI")
- SET ^%ZTSK(ZTSK,0)="^"_DUZ_"^"_Y_"^"_$HOROLOG
- SET ^("ZTSK")=ZTSK
- SET ^%ZTSCH(X,ZTSK)=IO
- SET AU("QUE")=""
- SET ^%ZTSK(ZTSK,"SITE")=SITENUM
- SET ^("DUZ(2)")=DUZ(2)
- END KILL AUQDATE
- QUIT
- KZTSK ;ENTRY POINT TO KILL ^%ZTSK AND SET ^%ZTSK(0)=1000
- +1 SET ^%ZTSK(0)=1000
- SET R=0
- K1 SET R=$ORDER(^%ZTSK(R))
- IF R=""
- QUIT
- KILL ^%ZTSK(R)
- GOTO K1
- KZTSCH ;ENTRY POINT TO KILL %ZTSCH FOR SCH BACKUP
- +1 SET AU=0
- Z1 SET AU=$ORDER(^%ZTSCH(AU))
- IF AU=""!($ORDER(^%ZTSCH(AU,0))'=999)
- QUIT
- KILL ^%ZTSCH(AU,999)
- GOTO Z1