LA7UIIN ;DALISC/JRR - Process Incoming Univ Interface Messages ; 12/3/1997
;;5.2;LAB MESSAGING;**17,23,27**;Sep 27, 1994
;This routine processes all incoming messages for the
;Universal Interface configuration.
QUIT
;
EN L +^LAHM(62.48,"Z",LA76248):10 ;only one job should run at at time
E QUIT
;
LOOP F LA7LOOP=1:1:60 DO GETIN H 5 ;main loop, LA7LOOP reset in GETIN
K LA7LOOP
L -^LAHM(62.48,"Z",LA76248)
I $D(ZTQUEUED) S ZTREQ="@"
QUIT ;quit main routine
;
GETIN ;Check the incoming queue for messages and then call LA7UIIN1 to
;process the message.
Q:'$O(^LAHM(62.49,"Q",LA76248,"IQ",0)) ;check incoming queue
S LA76249=0
S LA7LOOP=1 ;reset timeout counter
F S LA76249=$O(^LAHM(62.49,"Q",LA76248,"IQ",LA76249)) Q:'LA76249 D
. K TRAY,CUP,LWL,WL,LROVER,METH,LOG,IDENT,LADT,LAGEN,ISQN,IDE
. L +^LAHM(62.49,LA76249):1 Q:'$T ; Unable to get lock, messsage still building?.
. D NXTMSG^LA7UIIN1
. I $G(LA7INST)="" S LA7INST="UNKNOWN"
. S DR="5////"_$P(LA7INST,"^")_"-I-"_$S($L(LA7UID):LA7UID,1:LA7AN) ; Set instrument name-message type-unique identifier or accession # as INSTRUMENT NAME.
. I $P($G(^LAHM(62.49,LA76249,0)),"^",3)'="E" S DR=DR_";2////X" ;set status to purgeable
. S DIE="^LAHM(62.49,",DA=LA76249
. D ^DIE ;set status to purgeable
. I $D(^LAHM(62.48,+$G(LA76248),20,"B",1)) D XQA^LA7UXQA(1,LA76248)
. L -^LAHM(62.49,LA76249) ; Release lock.
K ^TMP("LA7TREE",$J)
QUIT ;quit GETIN subroutine
;
QUE ;call here to queue this processing routine to run in the
;background. Required variables are:
;LA76248=pointer to configuration in 62.48
L +^LAHM(62.48,"Z",LA76248):1 ;see if already running
E L -^LAHM(62.48,"Z",LA76248) QUIT
S ZTRTN="EN^LA7UIIN",ZTDTH=$H,ZTIO=""
S ZTDESC="Processing Routine for "_$P(^LAHM(62.48,LA76248,0),"^")
S ZTSAVE("LA76248")=LA76248
D ^%ZTLOAD
L -^LAHM(62.48,"Z",LA76248)
K ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
QUIT ;quit QUE subroutine call
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UIIN 1964 printed Dec 13, 2024@01:39:50 Page 2
LA7UIIN ;DALISC/JRR - Process Incoming Univ Interface Messages ; 12/3/1997
+1 ;;5.2;LAB MESSAGING;**17,23,27**;Sep 27, 1994
+2 ;This routine processes all incoming messages for the
+3 ;Universal Interface configuration.
+4 QUIT
+5 ;
EN ;only one job should run at at time
LOCK +^LAHM(62.48,"Z",LA76248):10
+1 IF '$TEST
QUIT
+2 ;
LOOP ;main loop, LA7LOOP reset in GETIN
FOR LA7LOOP=1:1:60
DO GETIN
HANG 5
+1 KILL LA7LOOP
+2 LOCK -^LAHM(62.48,"Z",LA76248)
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 ;quit main routine
QUIT
+5 ;
GETIN ;Check the incoming queue for messages and then call LA7UIIN1 to
+1 ;process the message.
+2 ;check incoming queue
if '$ORDER(^LAHM(62.49,"Q",LA76248,"IQ",0))
QUIT
+3 SET LA76249=0
+4 ;reset timeout counter
SET LA7LOOP=1
+5 FOR
SET LA76249=$ORDER(^LAHM(62.49,"Q",LA76248,"IQ",LA76249))
if 'LA76249
QUIT
Begin DoDot:1
+6 KILL TRAY,CUP,LWL,WL,LROVER,METH,LOG,IDENT,LADT,LAGEN,ISQN,IDE
+7 ; Unable to get lock, messsage still building?.
LOCK +^LAHM(62.49,LA76249):1
if '$TEST
QUIT
+8 DO NXTMSG^LA7UIIN1
+9 IF $GET(LA7INST)=""
SET LA7INST="UNKNOWN"
+10 ; Set instrument name-message type-unique identifier or accession # as INSTRUMENT NAME.
SET DR="5////"_$PIECE(LA7INST,"^")_"-I-"_$SELECT($LENGTH(LA7UID):LA7UID,1:LA7AN)
+11 ;set status to purgeable
IF $PIECE($GET(^LAHM(62.49,LA76249,0)),"^",3)'="E"
SET DR=DR_";2////X"
+12 SET DIE="^LAHM(62.49,"
SET DA=LA76249
+13 ;set status to purgeable
DO ^DIE
+14 IF $DATA(^LAHM(62.48,+$GET(LA76248),20,"B",1))
DO XQA^LA7UXQA(1,LA76248)
+15 ; Release lock.
LOCK -^LAHM(62.49,LA76249)
End DoDot:1
+16 KILL ^TMP("LA7TREE",$JOB)
+17 ;quit GETIN subroutine
QUIT
+18 ;
QUE ;call here to queue this processing routine to run in the
+1 ;background. Required variables are:
+2 ;LA76248=pointer to configuration in 62.48
+3 ;see if already running
LOCK +^LAHM(62.48,"Z",LA76248):1
+4 IF '$TEST
LOCK -^LAHM(62.48,"Z",LA76248)
QUIT
+5 SET ZTRTN="EN^LA7UIIN"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+6 SET ZTDESC="Processing Routine for "_$PIECE(^LAHM(62.48,LA76248,0),"^")
+7 SET ZTSAVE("LA76248")=LA76248
+8 DO ^%ZTLOAD
+9 LOCK -^LAHM(62.48,"Z",LA76248)
+10 KILL ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
+11 ;quit QUE subroutine call
QUIT
