LA7ADL ;DALOI/JMC - Automatic Download of Test Orders ;11/23/10 12:04
;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57,66,74**;Sep 27, 1994;Build 229
;
; This routine will monitor the ^LA("ADL") node to check for accessions which are to have test orders automatically
; downloaded to another computer system. All entries in the auto instrument file which are flagged for automatic downloading
; will be checked to see if they contain any tests on the accession. If tests are found then the appropiate download message
; is constructed and sent.
;
;
EN(LA7UID) ; Set flag to check accession for downloading, start background job if needed.
; Called by LR7OMERG, LRCONJAM, LRTSTSET, LRWLST1.
;
; No UID passed to routine.
I $G(LA7UID)="" Q
;
; No instrument flagged for auto downloading.
I '$D(^LAB(62.4,"AE")) Q
;
; Quit if "Don't Start/Collect" flag set.
I +$G(^LA("ADL","STOP"),0)=3 Q
;
; Lock node in case already downloading this accession, wait until downloading finished.
L +^LA("ADL","Q",LA7UID):60
;
; Set flag to check this accession for auto downloading.
S ^LA("ADL","Q",LA7UID)=""
;
; Release lock.
L -^LA("ADL","Q",LA7UID)
;
; Quit if "Don't Start" flag set.
I +$G(^LA("ADL","STOP"),0)=2 Q
;
; Task background job to run.
D CHKTSK
;
; Unlock node.
L -^LA("ADL",0)
;
Q
;
;
DQ ; Entry point from Taskman.
;
; Wait for a little while in case another job checking for background job has lock.
L +^LA("ADL",0):10
; Another process has lock, only want one at a time.
I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
;
; No instrument flagged for auto downloading.
I '$D(^LAB(62.4,"AE")) D EXIT Q
;
; Quit if "Don't Start/Collect" flags set.
I +$G(^LA("ADL","STOP"),0)>1 Q
;
; Update XTMP entry to let auto download know we're running for this process
; and build table of tests to check for downloading}
D XTMP,BUILD
;
F D UID Q:TOUT>60
D EXIT
Q
;
;
UID ; Start loop to monitor for accessions to download.
;
N LA761,LRCOLLECT,LRDPF
;
S LA7UID="",(TOUT,ZTSTOP)=0
;
; Flag set to "Rebuild".
I +$G(^LA("ADL","STOP"))=1,'ZTSTOP D BUILD
;
F S LA7UID=$O(^LA("ADL","Q",LA7UID)) Q:LA7UID=""!(ZTSTOP)!(TOUT) D
. I +$G(^LA("ADL","STOP"))>0 S TOUT=61 Q
. I $$S^%ZTLOAD("Processing Lab UID "_LA7UID) S ZTSTOP=1,TOUT=61 Q
. ; Lock this UID, synch setting/deleting when another job is attempting to set node.
. D LOCK^DILF("^LA(""ADL"",""Q"",LA7UID)")
. ; Unable to get lock, go on to next UID, check again on next go around.
. I '$T Q
. ; Get accession info from ^LRO(68,"C").
. S X=$Q(^LRO(68,"C",LA7UID))
. ; Quit - UID does not match.
. I $QS(X,3)'=LA7UID D CLEANUP Q
. ;
. ; Setup accession variables for auto downloading.
. S LRAA=+$QS(X,4),LRAD=+$QS(X,5),LRAN=+$QS(X,6)
. S LRDPF=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
. S LRCOLLECT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",3)
. S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)),LA761=0
. I X>0 S LA761=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0)),"^")
. ;
. D BLDTST
. S LA7INST=0
. F S LA7INST=$O(LA7AUTO(LA7INST)) Q:'LA7INST D
. . D CHKTEST
. . ; No tests on instrument list for this accession.
. . I '$D(LA7ACC) Q
. . S LRINST=LA7INST,LRAUTO=LA7AUTO(LA7INST)
. . N LA7UID,LRDPF
. . ; File build (entry^routine) from fields #93 and #94 in file #62.4.
. . D @$P(LA7AUTO(LA7INST,9),"^",3,4)
. D CLEANUP,XTMP
;
F D Q:$O(^LA("ADL","Q",""))'="" Q:TOUT>60
. I $G(^LA("ADL","STOP"))>1 S TOUT=61 Q
. ; Task has been requested to stop.
. I $$S^%ZTLOAD("Idle - waiting for new accessions to process") S TOUT=61,ZTSTOP=1 Q
. S TOUT=TOUT+1 H 5 D XTMP
;
Q
;
;
BLDTST ; Build array of tests on accession to check for downloading
;
N X,LA760,LA7PCNT
;
K LA7TREE
S LA760=0
F S LA760=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760)) Q:'LA760 D
. ; Quit if test has been removed from accession.
. S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760,0),0) Q:'X
. ; If test completed (#4, COMPLETE DATE entered), don't download.
. I $P(X,"^",5) Q
. ; Build array of atomic tests on accession with urgency.
. S LA7PCNT=0
. D UNWIND^LA7ADL1(LA760,$P(X,"^",2),LA760)
;
Q
;
;
CHKTEST ; Check tests to determine if they should build in message.
; Array LA7ACC returned with tests to send in message
;
N LA760,LA76205,LA768,LA7I
;
K LA7ACC
;
; Quit - specimen uncollected & don't download uncollected flag set.
; controls exempted.
; check not performed if variables not defined - using download a load list process
I $D(LRDPF),$D(LRCOLLECT),+LRDPF'=62.3,'LRCOLLECT,'$P(^TMP("LA7-INST",$J,LA7INST),"^") Q
;
S LA760=0
F S LA760=$O(LA7TREE(LA760)) Q:'LA760 D
. I '$D(^TMP("LA7-INST",$J,LA7INST,LA760)) Q
. S LA7I=0
. F S LA7I=$O(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I)) Q:'LA7I D
. . S LA76205=+$P(LA7TREE(LA760),"^")
. . D CHKMASK
;
Q
;
CHKMASK ; Check pattern mask for tests that match download pattern mask
;
; Any accession area, specimen, urgency
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,0)) D ADD Q
;
; Specific accession area, any specimen/urgency
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,0,0)) D ADD Q
;
; Specific specimen, any accession area/urgency
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,0)) D ADD Q
;
; Specific urgency, any accession area/specimen
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,LA76205)) D ADD Q
;
; Specific accession/specimen, any urgency
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,0)) D ADD Q
;
; Specific accession/urgency, any specimen
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,0,LA76205)) D ADD Q
;
; Specific specimen/urgency, any accession area
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,LA76205)) D ADD Q
;
; Specific accession/specimen/urgency
I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,LA76205)) D ADD Q
;
Q
;
;
ADD ; Add to list of tests to download
;
S LA7ACC(LA7I)=LA760_"^"_LA7TREE(LA760)
Q
;
;
CLEANUP ; Delete flag after accession has been checked.
; NOTE: Lock previously set above.
;
K ^LA("ADL","Q",LA7UID)
;
; Release lock on this UID.
L -^LA("ADL","Q",LA7UID)
;
Q
;
;
CHKTSK ; Check if we shoud task the auto download processing routine.
; Check if we recently tasked the processing routine for this process by compaing values in the XTMP global.
; Done to avoid repetitive locking attempts on each new accessione since the FileMan locking API uses a site-defined timeout which is usually 3 seconds
; but can be more. Slows down the interface if on each accession we are waiting 3 or more seconds for the lock to find out if the processing routine
; is already running.
;
N LA7X,LA7Y
S LA7X=$H,LA7Y=$G(^XTMP("LA7ADL",1))
I $P(LA7X,",")=$P(LA7Y,","),($P(LA7X,",",2)-$P(LA7Y,",",2))<240 Q
;
; Lock zeroth node.
; Quit if another process has lock - either another job setting node or the background job.
D LOCK^DILF("^LA(""ADL"",0)")
I '$T Q
;
;
ZTSK ; Task background job to run.
;
; Call here to queue this processing routine to run in the background.
;
; Task background job if not running.
N ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
S ZTRTN="DQ^LA7ADL",ZTDESC="Lab Auto Download",ZTIO="",ZTDTH=$H
D ^%ZTLOAD
;
Q
;
;
BUILD ; Build TMP global with list of tests for instruments flagged for auto download.
;
D BUILD^LA7ADL1
;
; Set flag to "Running".
D SETSTOP^LA7ADL1(0,$G(DUZ))
;
Q
;
;
XTMP ; Set/update XTMP with current run time of this processing routine
;
S DT=$$DT^XLFDT
S ^XTMP("LA7ADL",0)=DT_"^"_DT_"^LAB AUTO DOWNLOAD PROCESS TASKING"
S ^XTMP("LA7ADL",1)=$H
Q
;
;
EXIT ; Exit and cleanup.
;
; Release lock on LA("ADL") global.
L -^LA("ADL",0)
;
K ^TMP("LA7",$J),^TMP($J),^XTMP("LA7ADL",1)
K LA7ADL,LA7AUTO,LA7NVAF,LRAA,LRAD,LRAN,TOUT
;
; Clear flag if normal shutdown, no new accessions.
I +$G(^LA("ADL","STOP"))<2 K ^LA("ADL","STOP")
;
; Set flag for taskman to cleanup task.
I $D(ZTQUEUED) S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7ADL 8127 printed Nov 22, 2024@16:49:08 Page 2
LA7ADL ;DALOI/JMC - Automatic Download of Test Orders ;11/23/10 12:04
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57,66,74**;Sep 27, 1994;Build 229
+2 ;
+3 ; This routine will monitor the ^LA("ADL") node to check for accessions which are to have test orders automatically
+4 ; downloaded to another computer system. All entries in the auto instrument file which are flagged for automatic downloading
+5 ; will be checked to see if they contain any tests on the accession. If tests are found then the appropiate download message
+6 ; is constructed and sent.
+7 ;
+8 ;
EN(LA7UID) ; Set flag to check accession for downloading, start background job if needed.
+1 ; Called by LR7OMERG, LRCONJAM, LRTSTSET, LRWLST1.
+2 ;
+3 ; No UID passed to routine.
+4 IF $GET(LA7UID)=""
QUIT
+5 ;
+6 ; No instrument flagged for auto downloading.
+7 IF '$DATA(^LAB(62.4,"AE"))
QUIT
+8 ;
+9 ; Quit if "Don't Start/Collect" flag set.
+10 IF +$GET(^LA("ADL","STOP"),0)=3
QUIT
+11 ;
+12 ; Lock node in case already downloading this accession, wait until downloading finished.
+13 LOCK +^LA("ADL","Q",LA7UID):60
+14 ;
+15 ; Set flag to check this accession for auto downloading.
+16 SET ^LA("ADL","Q",LA7UID)=""
+17 ;
+18 ; Release lock.
+19 LOCK -^LA("ADL","Q",LA7UID)
+20 ;
+21 ; Quit if "Don't Start" flag set.
+22 IF +$GET(^LA("ADL","STOP"),0)=2
QUIT
+23 ;
+24 ; Task background job to run.
+25 DO CHKTSK
+26 ;
+27 ; Unlock node.
+28 LOCK -^LA("ADL",0)
+29 ;
+30 QUIT
+31 ;
+32 ;
DQ ; Entry point from Taskman.
+1 ;
+2 ; Wait for a little while in case another job checking for background job has lock.
+3 LOCK +^LA("ADL",0):10
+4 ; Another process has lock, only want one at a time.
+5 IF '$TEST
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+6 ;
+7 ; No instrument flagged for auto downloading.
+8 IF '$DATA(^LAB(62.4,"AE"))
DO EXIT
QUIT
+9 ;
+10 ; Quit if "Don't Start/Collect" flags set.
+11 IF +$GET(^LA("ADL","STOP"),0)>1
QUIT
+12 ;
+13 ; Update XTMP entry to let auto download know we're running for this process
+14 ; and build table of tests to check for downloading}
+15 DO XTMP
DO BUILD
+16 ;
+17 FOR
DO UID
if TOUT>60
QUIT
+18 DO EXIT
+19 QUIT
+20 ;
+21 ;
UID ; Start loop to monitor for accessions to download.
+1 ;
+2 NEW LA761,LRCOLLECT,LRDPF
+3 ;
+4 SET LA7UID=""
SET (TOUT,ZTSTOP)=0
+5 ;
+6 ; Flag set to "Rebuild".
+7 IF +$GET(^LA("ADL","STOP"))=1
IF 'ZTSTOP
DO BUILD
+8 ;
+9 FOR
SET LA7UID=$ORDER(^LA("ADL","Q",LA7UID))
if LA7UID=""!(ZTSTOP)!(TOUT)
QUIT
Begin DoDot:1
+10 IF +$GET(^LA("ADL","STOP"))>0
SET TOUT=61
QUIT
+11 IF $$S^%ZTLOAD("Processing Lab UID "_LA7UID)
SET ZTSTOP=1
SET TOUT=61
QUIT
+12 ; Lock this UID, synch setting/deleting when another job is attempting to set node.
+13 DO LOCK^DILF("^LA(""ADL"",""Q"",LA7UID)")
+14 ; Unable to get lock, go on to next UID, check again on next go around.
+15 IF '$TEST
QUIT
+16 ; Get accession info from ^LRO(68,"C").
+17 SET X=$QUERY(^LRO(68,"C",LA7UID))
+18 ; Quit - UID does not match.
+19 IF $QSUBSCRIPT(X,3)'=LA7UID
DO CLEANUP
QUIT
+20 ;
+21 ; Setup accession variables for auto downloading.
+22 SET LRAA=+$QSUBSCRIPT(X,4)
SET LRAD=+$QSUBSCRIPT(X,5)
SET LRAN=+$QSUBSCRIPT(X,6)
+23 SET LRDPF=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
+24 SET LRCOLLECT=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",3)
+25 SET X=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
SET LA761=0
+26 IF X>0
SET LA761=+$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0)),"^")
+27 ;
+28 DO BLDTST
+29 SET LA7INST=0
+30 FOR
SET LA7INST=$ORDER(LA7AUTO(LA7INST))
if 'LA7INST
QUIT
Begin DoDot:2
+31 DO CHKTEST
+32 ; No tests on instrument list for this accession.
+33 IF '$DATA(LA7ACC)
QUIT
+34 SET LRINST=LA7INST
SET LRAUTO=LA7AUTO(LA7INST)
+35 NEW LA7UID,LRDPF
+36 ; File build (entry^routine) from fields #93 and #94 in file #62.4.
+37 DO @$PIECE(LA7AUTO(LA7INST,9),"^",3,4)
End DoDot:2
+38 DO CLEANUP
DO XTMP
End DoDot:1
+39 ;
+40 FOR
Begin DoDot:1
+41 IF $GET(^LA("ADL","STOP"))>1
SET TOUT=61
QUIT
+42 ; Task has been requested to stop.
+43 IF $$S^%ZTLOAD("Idle - waiting for new accessions to process")
SET TOUT=61
SET ZTSTOP=1
QUIT
+44 SET TOUT=TOUT+1
HANG 5
DO XTMP
End DoDot:1
if $ORDER(^LA("ADL","Q",""))'=""
QUIT
if TOUT>60
QUIT
+45 ;
+46 QUIT
+47 ;
+48 ;
BLDTST ; Build array of tests on accession to check for downloading
+1 ;
+2 NEW X,LA760,LA7PCNT
+3 ;
+4 KILL LA7TREE
+5 SET LA760=0
+6 FOR
SET LA760=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760))
if 'LA760
QUIT
Begin DoDot:1
+7 ; Quit if test has been removed from accession.
+8 SET X=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760,0),0)
if 'X
QUIT
+9 ; If test completed (#4, COMPLETE DATE entered), don't download.
+10 IF $PIECE(X,"^",5)
QUIT
+11 ; Build array of atomic tests on accession with urgency.
+12 SET LA7PCNT=0
+13 DO UNWIND^LA7ADL1(LA760,$PIECE(X,"^",2),LA760)
End DoDot:1
+14 ;
+15 QUIT
+16 ;
+17 ;
CHKTEST ; Check tests to determine if they should build in message.
+1 ; Array LA7ACC returned with tests to send in message
+2 ;
+3 NEW LA760,LA76205,LA768,LA7I
+4 ;
+5 KILL LA7ACC
+6 ;
+7 ; Quit - specimen uncollected & don't download uncollected flag set.
+8 ; controls exempted.
+9 ; check not performed if variables not defined - using download a load list process
+10 IF $DATA(LRDPF)
IF $DATA(LRCOLLECT)
IF +LRDPF'=62.3
IF 'LRCOLLECT
IF '$PIECE(^TMP("LA7-INST",$JOB,LA7INST),"^")
QUIT
+11 ;
+12 SET LA760=0
+13 FOR
SET LA760=$ORDER(LA7TREE(LA760))
if 'LA760
QUIT
Begin DoDot:1
+14 IF '$DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760))
QUIT
+15 SET LA7I=0
+16 FOR
SET LA7I=$ORDER(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I))
if 'LA7I
QUIT
Begin DoDot:2
+17 SET LA76205=+$PIECE(LA7TREE(LA760),"^")
+18 DO CHKMASK
End DoDot:2
End DoDot:1
+19 ;
+20 QUIT
+21 ;
CHKMASK ; Check pattern mask for tests that match download pattern mask
+1 ;
+2 ; Any accession area, specimen, urgency
+3 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,0,0,0))
DO ADD
QUIT
+4 ;
+5 ; Specific accession area, any specimen/urgency
+6 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,LRAA,0,0))
DO ADD
QUIT
+7 ;
+8 ; Specific specimen, any accession area/urgency
+9 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,0,LA761,0))
DO ADD
QUIT
+10 ;
+11 ; Specific urgency, any accession area/specimen
+12 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,0,0,LA76205))
DO ADD
QUIT
+13 ;
+14 ; Specific accession/specimen, any urgency
+15 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,LRAA,LA761,0))
DO ADD
QUIT
+16 ;
+17 ; Specific accession/urgency, any specimen
+18 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,LRAA,0,LA76205))
DO ADD
QUIT
+19 ;
+20 ; Specific specimen/urgency, any accession area
+21 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,0,LA761,LA76205))
DO ADD
QUIT
+22 ;
+23 ; Specific accession/specimen/urgency
+24 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,LRAA,LA761,LA76205))
DO ADD
QUIT
+25 ;
+26 QUIT
+27 ;
+28 ;
ADD ; Add to list of tests to download
+1 ;
+2 SET LA7ACC(LA7I)=LA760_"^"_LA7TREE(LA760)
+3 QUIT
+4 ;
+5 ;
CLEANUP ; Delete flag after accession has been checked.
+1 ; NOTE: Lock previously set above.
+2 ;
+3 KILL ^LA("ADL","Q",LA7UID)
+4 ;
+5 ; Release lock on this UID.
+6 LOCK -^LA("ADL","Q",LA7UID)
+7 ;
+8 QUIT
+9 ;
+10 ;
CHKTSK ; Check if we shoud task the auto download processing routine.
+1 ; Check if we recently tasked the processing routine for this process by compaing values in the XTMP global.
+2 ; Done to avoid repetitive locking attempts on each new accessione since the FileMan locking API uses a site-defined timeout which is usually 3 seconds
+3 ; but can be more. Slows down the interface if on each accession we are waiting 3 or more seconds for the lock to find out if the processing routine
+4 ; is already running.
+5 ;
+6 NEW LA7X,LA7Y
+7 SET LA7X=$HOROLOG
SET LA7Y=$GET(^XTMP("LA7ADL",1))
+8 IF $PIECE(LA7X,",")=$PIECE(LA7Y,",")
IF ($PIECE(LA7X,",",2)-$PIECE(LA7Y,",",2))<240
QUIT
+9 ;
+10 ; Lock zeroth node.
+11 ; Quit if another process has lock - either another job setting node or the background job.
+12 DO LOCK^DILF("^LA(""ADL"",0)")
+13 IF '$TEST
QUIT
+14 ;
+15 ;
ZTSK ; Task background job to run.
+1 ;
+2 ; Call here to queue this processing routine to run in the background.
+3 ;
+4 ; Task background job if not running.
+5 NEW ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
+6 SET ZTRTN="DQ^LA7ADL"
SET ZTDESC="Lab Auto Download"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+7 DO ^%ZTLOAD
+8 ;
+9 QUIT
+10 ;
+11 ;
BUILD ; Build TMP global with list of tests for instruments flagged for auto download.
+1 ;
+2 DO BUILD^LA7ADL1
+3 ;
+4 ; Set flag to "Running".
+5 DO SETSTOP^LA7ADL1(0,$GET(DUZ))
+6 ;
+7 QUIT
+8 ;
+9 ;
XTMP ; Set/update XTMP with current run time of this processing routine
+1 ;
+2 SET DT=$$DT^XLFDT
+3 SET ^XTMP("LA7ADL",0)=DT_"^"_DT_"^LAB AUTO DOWNLOAD PROCESS TASKING"
+4 SET ^XTMP("LA7ADL",1)=$HOROLOG
+5 QUIT
+6 ;
+7 ;
EXIT ; Exit and cleanup.
+1 ;
+2 ; Release lock on LA("ADL") global.
+3 LOCK -^LA("ADL",0)
+4 ;
+5 KILL ^TMP("LA7",$JOB),^TMP($JOB),^XTMP("LA7ADL",1)
+6 KILL LA7ADL,LA7AUTO,LA7NVAF,LRAA,LRAD,LRAN,TOUT
+7 ;
+8 ; Clear flag if normal shutdown, no new accessions.
+9 IF +$GET(^LA("ADL","STOP"))<2
KILL ^LA("ADL","STOP")
+10 ;
+11 ; Set flag for taskman to cleanup task.
+12 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+13 QUIT
