LA7VIN ;DALOI/JMC - Process Incoming Lab HL7 Messages ;11/18/15 12:29
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,67,74,88**;Sep 27, 1994;Build 10
;
; This routine processes incoming messages for various Lab HL7 configurations.
Q
;
EN ; Only one process should run at a time
;
; Expects variable LA76248 = internal entry # of message configuration in LA7 MESSAGE PARAMETER file (#62.48)
;
N DIQUIET,LA76249,LA7I,LA7INTYP,LA7LOOP,LA7X,LRQUIET
;
; Prevent FileMan from issuing any unwanted WRITE(s).
S (DIQUIET,LRQUIET)=1
; Insure DT and DILOCKTM is defined
D DT^DICRW
;
L +^LAHM(62.48,"Z",LA76248):10
E S:$D(ZTQUEUED) ZTREQ="@" Q
;
; Setup DUZ array to 'non-human' user LRLAB,HL
; If user not found - send alert to G.LAB MESSAGING
S LA7X=$P($G(^XTMP("LA7 PROXY","LRLAB,HL")),"^")
I LA7X<1 D
. S LA7X=$$FIND1^DIC(200,"","OQUX","LRLAB,HL","B","")
. S ^XTMP("LA7 PROXY",0)=DT_"^"_DT_"^LAB HL7 PROXY USERS"
. I LA7X>0 S ^XTMP("LA7 PROXY","LRLAB,HL")=LA7X
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)
. L -^LAHM(62.48,"Z",LA76248)
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
. I LA7LOOP<60 H 5
;
; Release lock
L -^LAHM(62.48,"Z",LA76248)
;
; Kill running flag
K ^XTMP("LA7VIN",LA76248)
;
; Clean up taskman
I $D(ZTQUEUED) S ZTREQ="@"
;
; Check TaskMan for scheduled lab option
D CHECKTM
;
; Check if LAB MESSAGING mail group has active members
D CHECKMG
;
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.
;
; LA7MSGPROCESSED is a counter of number of messages processed. Used to insure if volume of messages
; being received results in the "IQ" not being empty that the processing routine to process
; the information in LAH is periodically tasked for those interfaces (POC, etc) that have such a behavior.
;
N LA7MSGPROCESSED
S LA7MSGPROCESSED=0
;
; Update XTMP entry to let messaging know we're still running for this configuration.
D XTMP
;
; 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):DILOCKTM
. I '$T H 5 Q
. D NXTMSG^LA7VIN1
. L -^LAHM(62.49,LA76249)
. S LA7MSGPROCESSED=LA7MSGPROCESSED+1
. I (LA7MSGPROCESSED#10)=0 D CHKPROC
;
K ^TMP("LA7TREE",$J)
;
D CHKPROC
;
Q
;
;
CHKPROC ; Check if any processing routine need to be tasked to process info in LAH
;
; 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,"EN^LRVRPOC")
. . K LA7INTYP("LWL",LA7I)
;
; If universal interface and auto-release turned on then task job(s) to process results in LAH. ;**88
I LA7INTYP=1,$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,"EN^LRVRAR")
. . 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
;
; Check if we recently tasked the processing routine for this configuration.
; Done to avoid repetitive locking attempts on each new message 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 message 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("LA7VIN",LA76248))
I $P(LA7X,",")=$P(LA7Y,","),($P(LA7X,",",2)-$P(LA7Y,",",2))<240 Q
;
; See if already running
L +^LAHM(62.48,"Z",LA76248):DILOCKTM
I '$T Q
;
N ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
S ZTRTN="EN^LA7VIN",ZTDTH=$H,ZTIO=""
S ZTDESC="Processing Routine for "_$P(^LAHM(62.48,LA76248,0),"^")
S ZTSAVE("LA76248")=LA76248
D ^%ZTLOAD
;
D XTMP
;
L -^LAHM(62.48,"Z",LA76248)
;
Q
;
;
QLAH(LWL,ZTRTN) ; Call here to queue result processing routine to run in the background.
; Call with LWL = pointer to load list in file #68.2
; ZTRTN = name of processing routine to task
;
;
; See if already running
L +^LAH("Z",LWL):DILOCKTM
I '$T Q
L -^LAH("Z",LWL)
;
N ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
S ZTDTH=$H,ZTIO="",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^LA7-MESSAGE-CHECKTM"
D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
Q
;
;
CHECKMG ; Check if LAB MESSAGING mail group has active members.
;
N XMERR,XQA,XQAID,XQAMSG
;
; See if mail group check has been done today
I $P($G(^XTMP("LA7CHECKMG",0)),"^",2)=DT Q
;
; Set flag that we've check the membership today.
S ^XTMP("LA7CHECKMG",0)=DT_"^"_DT_"^LAB HL7 CHECK LAB MESSAGING MAIL GROUP MEMBERS"
;
K ^TMP("XMERR",$J)
I $$GOTLOCAL^XMXAPIG("LAB MESSAGING") Q
;
; Mail group has no active members
S XQAMSG="Lab Messaging - Mail group LAB MESSAGING has no active members"
; Delete previous alerts
S XQAID="LA7-MESSAGE-CHECKMG"
D DEL^LA7UXQA(XQAID)
;
; Send alert to holders of mail group LMI
I $$GOTLOCAL^XMXAPIG("LMI") D Q
. S XQA("G.LMI")=""
. D SETUP^XQALERT
. K ^TMP("XMERR",$J)
;
; Neither LAB MESSAGING or LMI mail groups have active members - send alert to holders of LRLIASON security key
S XQAMSG="Lab Messaging - Mail groups LAB MESSAGING and LMI have no active members"
M XQA=^XUSEC("LRLIASON")
D SETUP^XQALERT
K ^TMP("XMERR",$J)
;
Q
;
;
XTMP ; Set/update XTMP with current run time of this processing routine
;
S ^XTMP("LA7VIN",0)=DT_"^"_DT_"^LAB HL7 PROCESS TASKING"
S ^XTMP("LA7VIN",LA76248)=$H
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VIN 7047 printed Apr 09, 2024@20:44:39 Page 2
LA7VIN ;DALOI/JMC - Process Incoming Lab HL7 Messages ;11/18/15 12:29
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,67,74,88**;Sep 27, 1994;Build 10
+2 ;
+3 ; This routine processes incoming messages for various Lab HL7 configurations.
+4 QUIT
+5 ;
EN ; Only one process should run at a time
+1 ;
+2 ; Expects variable LA76248 = internal entry # of message configuration in LA7 MESSAGE PARAMETER file (#62.48)
+3 ;
+4 NEW DIQUIET,LA76249,LA7I,LA7INTYP,LA7LOOP,LA7X,LRQUIET
+5 ;
+6 ; Prevent FileMan from issuing any unwanted WRITE(s).
+7 SET (DIQUIET,LRQUIET)=1
+8 ; Insure DT and DILOCKTM is defined
+9 DO DT^DICRW
+10 ;
+11 LOCK +^LAHM(62.48,"Z",LA76248):10
+12 IF '$TEST
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+13 ;
+14 ; Setup DUZ array to 'non-human' user LRLAB,HL
+15 ; If user not found - send alert to G.LAB MESSAGING
+16 SET LA7X=$PIECE($GET(^XTMP("LA7 PROXY","LRLAB,HL")),"^")
+17 IF LA7X<1
Begin DoDot:1
+18 SET LA7X=$$FIND1^DIC(200,"","OQUX","LRLAB,HL","B","")
+19 SET ^XTMP("LA7 PROXY",0)=DT_"^"_DT_"^LAB HL7 PROXY USERS"
+20 IF LA7X>0
SET ^XTMP("LA7 PROXY","LRLAB,HL")=LA7X
End DoDot:1
+21 IF LA7X<1
Begin DoDot:1
+22 NEW MSG
+23 SET MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
+24 DO XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
+25 LOCK -^LAHM(62.48,"Z",LA76248)
End DoDot:1
QUIT
+26 DO DUZ^XUP(LA7X)
+27 ;
+28 ; Determine interface type
+29 SET LA7INTYP=+$PIECE(^LAHM(62.48,LA76248,0),"^",9)
+30 ;
+31 ; main loop, LA7LOOP reset in GETIN, if no messages for 5 minutes (60x5) then quit
+32 FOR LA7LOOP=1:1:60
Begin DoDot:1
+33 ; Check if task has been requested to stop
+34 IF $$S^%ZTLOAD("Idle - waiting for new messages to process")
SET ZTSTOP=1
QUIT
+35 DO GETIN
+36 IF LA7LOOP<60
HANG 5
End DoDot:1
if $GET(ZTSTOP)
QUIT
+37 ;
+38 ; Release lock
+39 LOCK -^LAHM(62.48,"Z",LA76248)
+40 ;
+41 ; Kill running flag
+42 KILL ^XTMP("LA7VIN",LA76248)
+43 ;
+44 ; Clean up taskman
+45 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+46 ;
+47 ; Check TaskMan for scheduled lab option
+48 DO CHECKTM
+49 ;
+50 ; Check if LAB MESSAGING mail group has active members
+51 DO CHECKMG
+52 ;
+53 KILL LA76248
+54 KILL CENUM,DPF,ECHOALL,ER,IDE,IDT,LALCT,LANM,LAZZ,LINK,LRTEC,NOW,RMK,T,TC,TP,TSK,WDT
+55 QUIT
+56 ;
+57 ;
GETIN ; Check the incoming queue for messages and then call LA7VIN1 to process the message.
+1 ;
+2 ; LA7MSGPROCESSED is a counter of number of messages processed. Used to insure if volume of messages
+3 ; being received results in the "IQ" not being empty that the processing routine to process
+4 ; the information in LAH is periodically tasked for those interfaces (POC, etc) that have such a behavior.
+5 ;
+6 NEW LA7MSGPROCESSED
+7 SET LA7MSGPROCESSED=0
+8 ;
+9 ; Update XTMP entry to let messaging know we're still running for this configuration.
+10 DO XTMP
+11 ;
+12 ; Check incoming queue
+13 if '$ORDER(^LAHM(62.49,"Q",LA76248,"IQ",0))
QUIT
+14 ;
+15 ; Reset timeout counter
+16 SET LA7LOOP=1
+17 ;
+18 ; Get lock on message, quit if still building, process message then release lock.
+19 FOR
SET LA76249=$ORDER(^LAHM(62.49,"Q",LA76248,"IQ",0))
if 'LA76249
QUIT
Begin DoDot:1
+20 ; Check if task has been requested to stop
+21 IF $$S^%ZTLOAD("Processing msg #"_LA76249)
SET ZTSTOP=1
QUIT
+22 LOCK +^LAHM(62.49,LA76249):DILOCKTM
+23 IF '$TEST
HANG 5
QUIT
+24 DO NXTMSG^LA7VIN1
+25 LOCK -^LAHM(62.49,LA76249)
+26 SET LA7MSGPROCESSED=LA7MSGPROCESSED+1
+27 IF (LA7MSGPROCESSED#10)=0
DO CHKPROC
End DoDot:1
if $GET(ZTSTOP)
QUIT
+28 ;
+29 KILL ^TMP("LA7TREE",$JOB)
+30 ;
+31 DO CHKPROC
+32 ;
+33 QUIT
+34 ;
+35 ;
CHKPROC ; Check if any processing routine need to be tasked to process info in LAH
+1 ;
+2 ; If point of care interface then task job(s) to process results in LAH.
+3 IF LA7INTYP>19
IF LA7INTYP<30
IF $DATA(LA7INTYP("LWL"))
Begin DoDot:1
+4 IF $GET(ZTSTOP)=1
QUIT
+5 SET LA7I=0
+6 FOR
SET LA7I=$ORDER(LA7INTYP("LWL",LA7I))
if 'LA7I
QUIT
Begin DoDot:2
+7 DO QLAH(LA7I,"EN^LRVRPOC")
+8 KILL LA7INTYP("LWL",LA7I)
End DoDot:2
End DoDot:1
+9 ;
+10 ; If universal interface and auto-release turned on then task job(s) to process results in LAH. ;**88
+11 IF LA7INTYP=1
IF $DATA(LA7INTYP("LWL"))
Begin DoDot:1
+12 IF $GET(ZTSTOP)=1
QUIT
+13 SET LA7I=0
+14 FOR
SET LA7I=$ORDER(LA7INTYP("LWL",LA7I))
if 'LA7I
QUIT
Begin DoDot:2
+15 DO QLAH(LA7I,"EN^LRVRAR")
+16 KILL LA7INTYP("LWL",LA7I)
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT
+19 ;
+20 ;
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 ; Check if we recently tasked the processing routine for this configuration.
+4 ; Done to avoid repetitive locking attempts on each new message since the
+5 ; FileMan locking API uses a site-defined timeout which is usually 3 seconds
+6 ; but can be more. Slows down the interface if on each message we are waiting
+7 ; 3 or more seconds for the lock to find out if the processing routine is already
+8 ; running.
+9 NEW LA7X,LA7Y
+10 SET LA7X=$HOROLOG
SET LA7Y=$GET(^XTMP("LA7VIN",LA76248))
+11 IF $PIECE(LA7X,",")=$PIECE(LA7Y,",")
IF ($PIECE(LA7X,",",2)-$PIECE(LA7Y,",",2))<240
QUIT
+12 ;
+13 ; See if already running
+14 LOCK +^LAHM(62.48,"Z",LA76248):DILOCKTM
+15 IF '$TEST
QUIT
+16 ;
+17 NEW ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
+18 SET ZTRTN="EN^LA7VIN"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+19 SET ZTDESC="Processing Routine for "_$PIECE(^LAHM(62.48,LA76248,0),"^")
+20 SET ZTSAVE("LA76248")=LA76248
+21 DO ^%ZTLOAD
+22 ;
+23 DO XTMP
+24 ;
+25 LOCK -^LAHM(62.48,"Z",LA76248)
+26 ;
+27 QUIT
+28 ;
+29 ;
QLAH(LWL,ZTRTN) ; Call here to queue result processing routine to run in the background.
+1 ; Call with LWL = pointer to load list in file #68.2
+2 ; ZTRTN = name of processing routine to task
+3 ;
+4 ;
+5 ; See if already running
+6 LOCK +^LAH("Z",LWL):DILOCKTM
+7 IF '$TEST
QUIT
+8 LOCK -^LAH("Z",LWL)
+9 ;
+10 NEW ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+11 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET ZTDESC="Result Processing for "_$PIECE(^LRO(68.2,LWL,0),"^")
+12 SET ZTSAVE("LRLL")=LWL
+13 DO ^%ZTLOAD
+14 ;
+15 QUIT
+16 ;
+17 ;
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^LA7-MESSAGE-CHECKTM"
+14 DO XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
+15 QUIT
+16 ;
+17 ;
CHECKMG ; Check if LAB MESSAGING mail group has active members.
+1 ;
+2 NEW XMERR,XQA,XQAID,XQAMSG
+3 ;
+4 ; See if mail group check has been done today
+5 IF $PIECE($GET(^XTMP("LA7CHECKMG",0)),"^",2)=DT
QUIT
+6 ;
+7 ; Set flag that we've check the membership today.
+8 SET ^XTMP("LA7CHECKMG",0)=DT_"^"_DT_"^LAB HL7 CHECK LAB MESSAGING MAIL GROUP MEMBERS"
+9 ;
+10 KILL ^TMP("XMERR",$JOB)
+11 IF $$GOTLOCAL^XMXAPIG("LAB MESSAGING")
QUIT
+12 ;
+13 ; Mail group has no active members
+14 SET XQAMSG="Lab Messaging - Mail group LAB MESSAGING has no active members"
+15 ; Delete previous alerts
+16 SET XQAID="LA7-MESSAGE-CHECKMG"
+17 DO DEL^LA7UXQA(XQAID)
+18 ;
+19 ; Send alert to holders of mail group LMI
+20 IF $$GOTLOCAL^XMXAPIG("LMI")
Begin DoDot:1
+21 SET XQA("G.LMI")=""
+22 DO SETUP^XQALERT
+23 KILL ^TMP("XMERR",$JOB)
End DoDot:1
QUIT
+24 ;
+25 ; Neither LAB MESSAGING or LMI mail groups have active members - send alert to holders of LRLIASON security key
+26 SET XQAMSG="Lab Messaging - Mail groups LAB MESSAGING and LMI have no active members"
+27 MERGE XQA=^XUSEC("LRLIASON")
+28 DO SETUP^XQALERT
+29 KILL ^TMP("XMERR",$JOB)
+30 ;
+31 QUIT
+32 ;
+33 ;
XTMP ; Set/update XTMP with current run time of this processing routine
+1 ;
+2 SET ^XTMP("LA7VIN",0)=DT_"^"_DT_"^LAB HL7 PROCESS TASKING"
+3 SET ^XTMP("LA7VIN",LA76248)=$HOROLOG
+4 QUIT
