LA7VIN ;VA/DALOI/JMC - Process Incoming Lab HL7 Messages ; Jan 12, 2005
;;5.2;AUTOMATED LAB INSTRUMENTS;**1031**;NOV 01, 1997
;
;;VA LA Patche(s): 46,67
;
; This routine processes incoming messages for various Lab HL7 configurations.
Q
;
EN ; Only one process should run at a time
N LA76249,LA7I,LA7INTYP,LA7LOOP,LA7X
;
L +^LAHM(62.48,"Z",LA76248):10
E Q
;
; Setup DUZ array to 'non-human' user LRLAB,HL
; If user not found - send alert to G.LAB MESSAGING
S LA7X=$$FIND1^DIC(200,"","OX","LRLAB,HL","B","")
I LA7X<1 D Q
. N MSG
. S MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
. D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
D DUZ^XUP(LA7X)
;
; Determine interface type
S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
;
; main loop, LA7LOOP reset in GETIN, if no messages for 5 minutes (60x5) then quit
F LA7LOOP=1:1:60 D Q:$G(ZTSTOP)
. ; Check if task has been requested to stop
. I $$S^%ZTLOAD("Idle - waiting for new messages to process") S ZTSTOP=1 Q
. D GETIN H 5
;
; Release lock
L -^LAHM(62.48,"Z",LA76248)
;
; Clean up taskman
I $D(ZTQUEUED) S ZTREQ="@"
;
; Check TaskMan for scheduled lab option
D CHECKTM
;
K LA76248
K CENUM,DPF,ECHOALL,ER,IDE,IDT,LALCT,LANM,LAZZ,LINK,LRTEC,NOW,RMK,T,TC,TP,TSK,WDT
Q
;
;
GETIN ; Check the incoming queue for messages and then call LA7VIN1 to
; process the message.
;
; Check incoming queue
Q:'$O(^LAHM(62.49,"Q",LA76248,"IQ",0))
;
; Reset timeout counter
S LA7LOOP=1
;
; Get lock on message, quit if still building, process message then release lock.
F S LA76249=$O(^LAHM(62.49,"Q",LA76248,"IQ",0)) Q:'LA76249 D Q:$G(ZTSTOP)
. ; Check if task has been requested to stop
. I $$S^%ZTLOAD("Processing msg #"_LA76249) S ZTSTOP=1 Q
. L +^LAHM(62.49,LA76249):1
. I '$T H 5 Q
. D NXTMSG^LA7VIN1
. L -^LAHM(62.49,LA76249)
;
K ^TMP("LA7TREE",$J)
;
; If point of care interface then task job(s) to process results in LAH.
I LA7INTYP>19,LA7INTYP<30,$D(LA7INTYP("LWL")) D
. I $G(ZTSTOP)=1 Q
. S LA7I=0
. F S LA7I=$O(LA7INTYP("LWL",LA7I)) Q:'LA7I D
. . D QLAH(LA7I)
. . K LA7INTYP("LWL",LA7I)
;
Q
;
;
QUE ; Call here to queue this processing routine to run in the background.
; Required variables are: LA76248 = pointer to configuration in 62.48
;
N ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
;
; See if already running
L +^LAHM(62.48,"Z",LA76248):1
E Q
;
S ZTRTN="EN^LA7VIN",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)
;
Q
;
;
QLAH(LWL) ; Call here to queue result processing routine to run in the background.
; Call with LWL = pointer to loadlist in file #68.2
;
N ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
;
; See if already running
L +^LAH("Z",LWL):0
E Q
L -^LAH("Z",LWL)
;
S ZTRTN="EN^LRVRPOC",ZTDTH=$H,ZTIO=""
S ZTDESC="Result Processing for "_$P(^LRO(68.2,LWL,0),"^")
S ZTSAVE("LRLL")=LWL
D ^%ZTLOAD
;
;
Q
;
;
CHECKTM ; Check is LA7TASK NIGHTY is scheduled in TaskMan.
;
N LA7TSK,LA7J,MSG,NOW,OK
S (LA7TSK,OK)=0
D OPTSTAT^XUTMOPT("LA7TASK NIGHTY",.LA7TSK)
;
; If scheduled check to see if for the future
I LA7TSK>0 D
. S LA7J=0,NOW=$$NOW^XLFDT
. F S LA7J=$O(LA7TSK(LA7J)) Q:'LA7J I $P(LA7TSK(LA7J),"^",2)>NOW S OK=1 Q
I OK Q
;
; Option is not scheduled - send alert to G.LAB MESSAGING
S MSG="Lab Messaging - Option LA7TASK NIGHTY is not scheduled in TaskMan"
D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
Q
LA7VIN ;VA/DALOI/JMC - Process Incoming Lab HL7 Messages ; Jan 12, 2005
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**1031**;NOV 01, 1997
+2 ;
+3 ;;VA LA Patche(s): 46,67
+4 ;
+5 ; This routine processes incoming messages for various Lab HL7 configurations.
+6 QUIT
+7 ;
EN ; Only one process should run at a time
+1 NEW LA76249,LA7I,LA7INTYP,LA7LOOP,LA7X
+2 ;
+3 LOCK +^LAHM(62.48,"Z",LA76248):10
+4 IF '$TEST
QUIT
+5 ;
+6 ; Setup DUZ array to 'non-human' user LRLAB,HL
+7 ; If user not found - send alert to G.LAB MESSAGING
+8 SET LA7X=$$FIND1^DIC(200,"","OX","LRLAB,HL","B","")
+9 IF LA7X<1
Begin DoDot:1
+10 NEW MSG
+11 SET MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
+12 DO XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
End DoDot:1
QUIT
+13 DO DUZ^XUP(LA7X)
+14 ;
+15 ; Determine interface type
+16 SET LA7INTYP=+$PIECE(^LAHM(62.48,LA76248,0),"^",9)
+17 ;
+18 ; main loop, LA7LOOP reset in GETIN, if no messages for 5 minutes (60x5) then quit
+19 FOR LA7LOOP=1:1:60
Begin DoDot:1
+20 ; Check if task has been requested to stop
+21 IF $$S^%ZTLOAD("Idle - waiting for new messages to process")
SET ZTSTOP=1
QUIT
+22 DO GETIN
HANG 5
End DoDot:1
IF $GET(ZTSTOP)
QUIT
+23 ;
+24 ; Release lock
+25 LOCK -^LAHM(62.48,"Z",LA76248)
+26 ;
+27 ; Clean up taskman
+28 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+29 ;
+30 ; Check TaskMan for scheduled lab option
+31 DO CHECKTM
+32 ;
+33 KILL LA76248
+34 KILL CENUM,DPF,ECHOALL,ER,IDE,IDT,LALCT,LANM,LAZZ,LINK,LRTEC,NOW,RMK,T,TC,TP,TSK,WDT
+35 QUIT
+36 ;
+37 ;
GETIN ; Check the incoming queue for messages and then call LA7VIN1 to
+1 ; process the message.
+2 ;
+3 ; Check incoming queue
+4 IF '$ORDER(^LAHM(62.49,"Q",LA76248,"IQ",0))
QUIT
+5 ;
+6 ; Reset timeout counter
+7 SET LA7LOOP=1
+8 ;
+9 ; Get lock on message, quit if still building, process message then release lock.
+10 FOR
SET LA76249=$ORDER(^LAHM(62.49,"Q",LA76248,"IQ",0))
IF 'LA76249
QUIT
Begin DoDot:1
+11 ; Check if task has been requested to stop
+12 IF $$S^%ZTLOAD("Processing msg #"_LA76249)
SET ZTSTOP=1
QUIT
+13 LOCK +^LAHM(62.49,LA76249):1
+14 IF '$TEST
HANG 5
QUIT
+15 DO NXTMSG^LA7VIN1
+16 LOCK -^LAHM(62.49,LA76249)
End DoDot:1
IF $GET(ZTSTOP)
QUIT
+17 ;
+18 KILL ^TMP("LA7TREE",$JOB)
+19 ;
+20 ; If point of care interface then task job(s) to process results in LAH.
+21 IF LA7INTYP>19
IF LA7INTYP<30
IF $DATA(LA7INTYP("LWL"))
Begin DoDot:1
+22 IF $GET(ZTSTOP)=1
QUIT
+23 SET LA7I=0
+24 FOR
SET LA7I=$ORDER(LA7INTYP("LWL",LA7I))
IF 'LA7I
QUIT
Begin DoDot:2
+25 DO QLAH(LA7I)
+26 KILL LA7INTYP("LWL",LA7I)
End DoDot:2
End DoDot:1
+27 ;
+28 QUIT
+29 ;
+30 ;
QUE ; Call here to queue this processing routine to run in the background.
+1 ; Required variables are: LA76248 = pointer to configuration in 62.48
+2 ;
+3 NEW ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
+4 ;
+5 ; See if already running
+6 LOCK +^LAHM(62.48,"Z",LA76248):1
+7 IF '$TEST
QUIT
+8 ;
+9 SET ZTRTN="EN^LA7VIN"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+10 SET ZTDESC="Processing Routine for "_$PIECE(^LAHM(62.48,LA76248,0),"^")
+11 SET ZTSAVE("LA76248")=LA76248
+12 DO ^%ZTLOAD
+13 ;
+14 LOCK -^LAHM(62.48,"Z",LA76248)
+15 ;
+16 QUIT
+17 ;
+18 ;
QLAH(LWL) ; Call here to queue result processing routine to run in the background.
+1 ; Call with LWL = pointer to loadlist in file #68.2
+2 ;
+3 NEW ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
+4 ;
+5 ; See if already running
+6 LOCK +^LAH("Z",LWL):0
+7 IF '$TEST
QUIT
+8 LOCK -^LAH("Z",LWL)
+9 ;
+10 SET ZTRTN="EN^LRVRPOC"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+11 SET ZTDESC="Result Processing for "_$PIECE(^LRO(68.2,LWL,0),"^")
+12 SET ZTSAVE("LRLL")=LWL
+13 DO ^%ZTLOAD
+14 ;
+15 ;
+16 QUIT
+17 ;
+18 ;
CHECKTM ; Check is LA7TASK NIGHTY is scheduled in TaskMan.
+1 ;
+2 NEW LA7TSK,LA7J,MSG,NOW,OK
+3 SET (LA7TSK,OK)=0
+4 DO OPTSTAT^XUTMOPT("LA7TASK NIGHTY",.LA7TSK)
+5 ;
+6 ; If scheduled check to see if for the future
+7 IF LA7TSK>0
Begin DoDot:1
+8 SET LA7J=0
SET NOW=$$NOW^XLFDT
+9 FOR
SET LA7J=$ORDER(LA7TSK(LA7J))
IF 'LA7J
QUIT
IF $PIECE(LA7TSK(LA7J),"^",2)>NOW
SET OK=1
QUIT
End DoDot:1
+10 IF OK
QUIT
+11 ;
+12 ; Option is not scheduled - send alert to G.LAB MESSAGING
+13 SET MSG="Lab Messaging - Option LA7TASK NIGHTY is not scheduled in TaskMan"
+14 DO XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
+15 QUIT
