LA7ADL ;VA/DALOI/JMC - Automatic Download of Test Orders; 1/30/95 09:00
;;5.2;AUTOMATED LAB INSTRUMENTS;**1001,1030**;NOV 01, 1997
;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57**;Sep 27, 1994
;
; 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
;
; Lock zeroth node.
; Quit if another process has lock
; - either another job setting node or the background job.
L +^LA("ADL",0):1
I '$T Q
;
; Task background job to run.
N ZTSK
D ZTSK
;
; Unlock node.
L -^LA("ADL",0)
;
Q
;
;
DQ ; Entry point from Taskman.
;
; Set flag for taskman to cleanup task.
I $D(ZTQUEUED) S ZTREQ="@"
;
; 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 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
;
D BUILD
;
F D UID Q:TOUT>60
D EXIT
Q
;
;
UID ; Start loop to monitor for accessions to download.
;
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 S ZTSTOP=1,TOUT=61 Q
. ; Lock this UID, synch setting/deleting when another job is attempting to set node.
. L +^LA("ADL","Q",LA7UID):1
. ; 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)
. ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
. I +$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))<1 D MAILALRT D CLEANUP Q
. ; ----- END IHS/OIT/MKK - LR*5.2*1030
. 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
. . ; File build (entry^routine) from fields #93 and #94 in file #62.4.
. . D @$P(LA7AUTO(LA7INST,9),"^",3,4)
. D CLEANUP
;
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 S TOUT=61,ZTSTOP=1 Q
. S TOUT=TOUT+1 H 5
;
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),0)
;
Q
;
;
CHKTEST ; Check tests to determine if they should build in message.
; Array LA7ACC returned with tests to send in message
;
N LA760,LA761,LA76205,LA768,LA7I,LRDPF,X
;
K LA7ACC
;
; Quit - specimen uncollected & don't download uncollected flag set.
; controls exempted.
S LRDPF=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
I LRDPF'=62.3,'$P(X,"^",3),'$P(^TMP("LA7-INST",$J,LA7INST),"^") Q
;
S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
;
Q:+$G(X)<1 ; If no SITE/SPECIMEN, Quit -- IHS/OIT/MKK - LR*5.2*1030
;
S LA761=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0),"^")
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 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
;
;
ZTSK ; Task background job to run.
;
N ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
;
; Task background job if not running.
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
;
;
EXIT ; Exit and cleanup.
;
; Release lock on LA("ADL") global.
L -^LA("ADL",0)
;
K ^TMP("LA7",$J),^TMP($J)
K LA7ADL
K LRAA,LRAD,LRAN
K TOUT
;
; Clear flag if normal shutdown, no new accessions.
I +$G(^LA("ADL","STOP"))<2 K ^LA("ADL","STOP")
;
Q
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; Only sent if the ACCESSION has no SPECIMEN node.
; Issue first surfaced at Chinle post Patch 1027 Install.
MAILALRT ; Send mail message alert
N J,LRCNT,LRMTXT,X,XMINSTR,XMSUB,XMTO
;
S LRMTXT(1)=" This is from routine LA7ADL."
S LRMTXT(2)=" "
S LRMTXT(3)=" This message was generated during the donwloading of"
S LRMTXT(4)=" information. The SPECIMEN node of this Accessions is"
S LRMTXT(5)=" NULL. This is an error."
S LRMTXT(6)=" "
S LRMTXT(7)=" The following *debugging* information is provided to"
S LRMTXT(8)=" assist support staff in resolving this error."
S LRMTXT(9)=" "
S LRCNT=9
;
F J="LA7UID","LRAA","LRAD","LRAN","LRDFN" D
. S X=$G(@J)
. I $L(X) S LRCNT=LRCNT+1,LRMTXT(LRCNT)=J_"="_X
. F S J=$Q(@J) Q:J="" S LRCNT=LRCNT+1,LRMTXT(LRCNT)=J_"="_@J
;
S XMSUB="ACCESSION has no SPECIMEN node."
S XMTO("G.LMI")=""
S XMINSTR("FROM")="Lab Routine LA7ADL"
S XMINSTR("ADDR FLAGS")="R"
D SENDMSG^XMXAPI(DUZ,XMSUB,"LRMTXT",.XMTO,.XMINSTR)
Q
;
; ----- END IHS/OIT/MKK - LR*5.2*1030
LA7ADL ;VA/DALOI/JMC - Automatic Download of Test Orders; 1/30/95 09:00
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**1001,1030**;NOV 01, 1997
+2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57**;Sep 27, 1994
+3 ;
+4 ; This routine will monitor the ^LA("ADL") node to check for accessions which are to have test orders automatically
+5 ; downloaded to another computer system. All entries in the auto instrument file which are flagged for automatic downloading
+6 ; will be checked to see if they contain any tests on the accession. If tests are found then the appropiate download message
+7 ; is constructed and sent.
+8 ;
+9 ;
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 ; Lock zeroth node.
+25 ; Quit if another process has lock
+26 ; - either another job setting node or the background job.
+27 LOCK +^LA("ADL",0):1
+28 IF '$TEST
QUIT
+29 ;
+30 ; Task background job to run.
+31 NEW ZTSK
+32 DO ZTSK
+33 ;
+34 ; Unlock node.
+35 LOCK -^LA("ADL",0)
+36 ;
+37 QUIT
+38 ;
+39 ;
DQ ; Entry point from Taskman.
+1 ;
+2 ; Set flag for taskman to cleanup task.
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 ;
+5 ; Wait for a little while in case another job checking for background job has lock.
+6 LOCK +^LA("ADL",0):10
+7 ; Another process has lock, only want one at a time.
+8 IF '$TEST
QUIT
+9 ;
+10 ; No instrument flagged for auto downloading.
+11 IF '$DATA(^LAB(62.4,"AE"))
DO EXIT
QUIT
+12 ;
+13 ; Quit if "Don't Start/Collect" flags set.
+14 IF +$GET(^LA("ADL","STOP"),0)>1
QUIT
+15 ;
+16 DO BUILD
+17 ;
+18 FOR
DO UID
IF TOUT>60
QUIT
+19 DO EXIT
+20 QUIT
+21 ;
+22 ;
UID ; Start loop to monitor for accessions to download.
+1 ;
+2 SET LA7UID=""
SET (TOUT,ZTSTOP)=0
+3 ;
+4 ; Flag set to "Rebuild".
+5 IF +$GET(^LA("ADL","STOP"))=1
IF 'ZTSTOP
DO BUILD
+6 ;
+7 FOR
SET LA7UID=$ORDER(^LA("ADL","Q",LA7UID))
IF LA7UID=""!(ZTSTOP)!(TOUT)
QUIT
Begin DoDot:1
+8 IF +$GET(^LA("ADL","STOP"))>0
SET TOUT=61
QUIT
+9 IF $$S^%ZTLOAD
SET ZTSTOP=1
SET TOUT=61
QUIT
+10 ; Lock this UID, synch setting/deleting when another job is attempting to set node.
+11 LOCK +^LA("ADL","Q",LA7UID):1
+12 ; Unable to get lock, go on to next UID, check again on next go around.
+13 IF '$TEST
QUIT
+14 ; Get accession info from ^LRO(68,"C").
+15 SET X=$QUERY(^LRO(68,"C",LA7UID))
+16 ; Quit - UID does not match.
+17 IF $QSUBSCRIPT(X,3)'=LA7UID
DO CLEANUP
QUIT
+18 ; Setup accession variables for auto downloading.
+19 SET LRAA=+$QSUBSCRIPT(X,4)
SET LRAD=+$QSUBSCRIPT(X,5)
SET LRAN=+$QSUBSCRIPT(X,6)
+20 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+21 IF +$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))<1
DO MAILALRT
DO CLEANUP
QUIT
+22 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+23 DO BLDTST
+24 SET LA7INST=0
+25 FOR
SET LA7INST=$ORDER(LA7AUTO(LA7INST))
IF 'LA7INST
QUIT
Begin DoDot:2
+26 DO CHKTEST
+27 ; No tests on instrument list for this accession.
+28 IF '$DATA(LA7ACC)
QUIT
+29 SET LRINST=LA7INST
SET LRAUTO=LA7AUTO(LA7INST)
+30 NEW LA7UID
+31 ; File build (entry^routine) from fields #93 and #94 in file #62.4.
+32 DO @$PIECE(LA7AUTO(LA7INST,9),"^",3,4)
End DoDot:2
+33 DO CLEANUP
End DoDot:1
+34 ;
+35 FOR
Begin DoDot:1
+36 IF $GET(^LA("ADL","STOP"))>1
SET TOUT=61
QUIT
+37 ; Task has been requested to stop.
+38 IF $$S^%ZTLOAD
SET TOUT=61
SET ZTSTOP=1
QUIT
+39 SET TOUT=TOUT+1
HANG 5
End DoDot:1
IF $ORDER(^LA("ADL","Q",""))'=""
QUIT
IF TOUT>60
QUIT
+40 ;
+41 QUIT
+42 ;
+43 ;
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),0)
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,LA761,LA76205,LA768,LA7I,LRDPF,X
+4 ;
+5 KILL LA7ACC
+6 ;
+7 ; Quit - specimen uncollected & don't download uncollected flag set.
+8 ; controls exempted.
+9 SET LRDPF=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
+10 SET X=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
+11 IF LRDPF'=62.3
IF '$PIECE(X,"^",3)
IF '$PIECE(^TMP("LA7-INST",$JOB,LA7INST),"^")
QUIT
+12 ;
+13 SET X=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
+14 ;
+15 ; If no SITE/SPECIMEN, Quit -- IHS/OIT/MKK - LR*5.2*1030
IF +$GET(X)<1
QUIT
+16 ;
+17 SET LA761=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0),"^")
+18 SET LA760=0
+19 FOR
SET LA760=$ORDER(LA7TREE(LA760))
IF 'LA760
QUIT
Begin DoDot:1
+20 IF '$DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760))
QUIT
+21 SET LA7I=0
+22 FOR
SET LA7I=$ORDER(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I))
IF 'LA7I
QUIT
Begin DoDot:2
+23 SET LA76205=+$PIECE(LA7TREE(LA760),"^")
+24 DO CHKMASK
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT
+27 ;
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 specimen/urgency, any accession area
+18 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,0,LA761,LA76205))
DO ADD
QUIT
+19 ;
+20 ; Specific accession/specimen/urgency
+21 IF $DATA(^TMP("LA7-INST",$JOB,LA7INST,LA760,LA7I,LRAA,LA761,LA76205))
DO ADD
QUIT
+22 ;
+23 QUIT
+24 ;
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 ;
ZTSK ; Task background job to run.
+1 ;
+2 NEW ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
+3 ;
+4 ; Task background job if not running.
+5 SET ZTRTN="DQ^LA7ADL"
SET ZTDESC="Lab Auto Download"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+6 DO ^%ZTLOAD
+7 ;
+8 QUIT
+9 ;
+10 ;
BUILD ; Build TMP global with list of tests for instruments flagged for auto download.
+1 DO BUILD^LA7ADL1
+2 ;
+3 ; Set flag to "Running".
+4 DO SETSTOP^LA7ADL1(0,$GET(DUZ))
+5 ;
+6 QUIT
+7 ;
+8 ;
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)
+6 KILL LA7ADL
+7 KILL LRAA,LRAD,LRAN
+8 KILL TOUT
+9 ;
+10 ; Clear flag if normal shutdown, no new accessions.
+11 IF +$GET(^LA("ADL","STOP"))<2
KILL ^LA("ADL","STOP")
+12 ;
+13 QUIT
+14 ;
+15 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+16 ; Only sent if the ACCESSION has no SPECIMEN node.
+17 ; Issue first surfaced at Chinle post Patch 1027 Install.
MAILALRT ; Send mail message alert
+1 NEW J,LRCNT,LRMTXT,X,XMINSTR,XMSUB,XMTO
+2 ;
+3 SET LRMTXT(1)=" This is from routine LA7ADL."
+4 SET LRMTXT(2)=" "
+5 SET LRMTXT(3)=" This message was generated during the donwloading of"
+6 SET LRMTXT(4)=" information. The SPECIMEN node of this Accessions is"
+7 SET LRMTXT(5)=" NULL. This is an error."
+8 SET LRMTXT(6)=" "
+9 SET LRMTXT(7)=" The following *debugging* information is provided to"
+10 SET LRMTXT(8)=" assist support staff in resolving this error."
+11 SET LRMTXT(9)=" "
+12 SET LRCNT=9
+13 ;
+14 FOR J="LA7UID","LRAA","LRAD","LRAN","LRDFN"
Begin DoDot:1
+15 SET X=$GET(@J)
+16 IF $LENGTH(X)
SET LRCNT=LRCNT+1
SET LRMTXT(LRCNT)=J_"="_X
+17 FOR
SET J=$QUERY(@J)
IF J=""
QUIT
SET LRCNT=LRCNT+1
SET LRMTXT(LRCNT)=J_"="_@J
End DoDot:1
+18 ;
+19 SET XMSUB="ACCESSION has no SPECIMEN node."
+20 SET XMTO("G.LMI")=""
+21 SET XMINSTR("FROM")="Lab Routine LA7ADL"
+22 SET XMINSTR("ADDR FLAGS")="R"
+23 DO SENDMSG^XMXAPI(DUZ,XMSUB,"LRMTXT",.XMTO,.XMINSTR)
+24 QUIT
+25 ;
+26 ; ----- END IHS/OIT/MKK - LR*5.2*1030
