BLRLIIN.m

BLRLIIN ;cmi/anch/maw - Process Incoming Univ Interface Messages 12/3/1997 ;JUL 06, 2010 3:14 PM

 ;;5.2;IHS LABORATORY;**1027**;NOV 01, 1997

 ;cmi/maw

 ;

 ;this is for LABCORP MESSAGING REFERENCE LAB

 ;;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^BLRLIIN1

 . 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^BLRLIIN",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

BLRLIIN   ;cmi/anch/maw - Process Incoming Univ Interface Messages 12/3/1997 ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;IHS LABORATORY;**1027**;NOV 01, 1997

 +2       ;cmi/maw

 +3       ;

 +4       ;this is for LABCORP MESSAGING REFERENCE LAB

 +5       ;;5.2;LAB MESSAGING;**17,23,27**;Sep 27, 1994

 +6       ;This routine processes all incoming messages for the

 +7       ;Universal Interface configuration.

 +8        QUIT 

 +9       ;

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^BLRLIIN1

 +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^BLRLIIN"

           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