Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VIN

LA7VIN.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; This routine processes incoming messages for various Lab HL7 configurations.
  1.  Q
  1.  ;
  1. EN ; Only one process should run at a time
  1.  ;
  1.  ; Expects variable LA76248 = internal entry # of message configuration in LA7 MESSAGE PARAMETER file (#62.48)
  1.  ;
  1.  N DIQUIET,LA76249,LA7I,LA7INTYP,LA7LOOP,LA7X,LRQUIET
  1.  ;
  1.  ; Prevent FileMan from issuing any unwanted WRITE(s).
  1.  S (DIQUIET,LRQUIET)=1
  1.  ; Insure DT and DILOCKTM is defined
  1.  D DT^DICRW
  1.  ;
  1.  L +^LAHM(62.48,"Z",LA76248):10
  1.  E  S:$D(ZTQUEUED) ZTREQ="@" Q
  1.  ;
  1.  ; Setup DUZ array to 'non-human' user LRLAB,HL
  1.  ; If user not found - send alert to G.LAB MESSAGING
  1.  S LA7X=$P($G(^XTMP("LA7 PROXY","LRLAB,HL")),"^")
  1.  I LA7X<1 D
  1.  . S LA7X=$$FIND1^DIC(200,"","OQUX","LRLAB,HL","B","")
  1.  . S ^XTMP("LA7 PROXY",0)=DT_"^"_DT_"^LAB HL7 PROXY USERS"
  1.  . I LA7X>0 S ^XTMP("LA7 PROXY","LRLAB,HL")=LA7X
  1.  I LA7X<1 D  Q
  1.  . N MSG
  1.  . S MSG="Lab Messaging - Unable to identify user 'LRLAB,HL' in NEW PERSON file"
  1.  . D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
  1.  . L -^LAHM(62.48,"Z",LA76248)
  1.  D DUZ^XUP(LA7X)
  1.  ;
  1.  ; Determine interface type
  1.  S LA7INTYP=+$P(^LAHM(62.48,LA76248,0),"^",9)
  1.  ;
  1.  ; main loop, LA7LOOP reset in GETIN, if no messages for 5 minutes (60x5) then quit
  1.  F LA7LOOP=1:1:60 D  Q:$G(ZTSTOP)
  1.  . ; Check if task has been requested to stop
  1.  . I $$S^%ZTLOAD("Idle - waiting for new messages to process") S ZTSTOP=1 Q
  1.  . D GETIN
  1.  . I LA7LOOP<60 H 5
  1.  ;
  1.  ; Release lock
  1.  L -^LAHM(62.48,"Z",LA76248)
  1.  ;
  1.  ; Kill running flag
  1.  K ^XTMP("LA7VIN",LA76248)
  1.  ;
  1.  ; Clean up taskman
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  ;
  1.  ; Check TaskMan for scheduled lab option
  1.  D CHECKTM
  1.  ;
  1.  ; Check if LAB MESSAGING mail group has active members
  1.  D CHECKMG
  1.  ;
  1.  K LA76248
  1.  K CENUM,DPF,ECHOALL,ER,IDE,IDT,LALCT,LANM,LAZZ,LINK,LRTEC,NOW,RMK,T,TC,TP,TSK,WDT
  1.  Q
  1.  ;
  1.  ;
  1. GETIN ; Check the incoming queue for messages and then call LA7VIN1 to process the message.
  1.  ;
  1.  ; LA7MSGPROCESSED is a counter of number of messages processed. Used to insure if volume of messages
  1.  ;  being received results in the "IQ" not being empty that the processing routine to process
  1.  ;  the information in LAH is periodically tasked for those interfaces (POC, etc) that have such a behavior.
  1.  ;
  1.  N LA7MSGPROCESSED
  1.  S LA7MSGPROCESSED=0
  1.  ;
  1.  ; Update XTMP entry to let messaging know we're still running for this configuration.
  1.  D XTMP
  1.  ;
  1.  ; Check incoming queue
  1.  Q:'$O(^LAHM(62.49,"Q",LA76248,"IQ",0))
  1.  ;
  1.  ; Reset timeout counter
  1.  S LA7LOOP=1
  1.  ;
  1.  ; Get lock on message, quit if still building, process message then release lock.
  1.  F  S LA76249=$O(^LAHM(62.49,"Q",LA76248,"IQ",0)) Q:'LA76249  D  Q:$G(ZTSTOP)
  1.  . ; Check if task has been requested to stop
  1.  . I $$S^%ZTLOAD("Processing msg #"_LA76249) S ZTSTOP=1 Q
  1.  . L +^LAHM(62.49,LA76249):DILOCKTM
  1.  . I '$T H 5 Q
  1.  . D NXTMSG^LA7VIN1
  1.  . L -^LAHM(62.49,LA76249)
  1.  . S LA7MSGPROCESSED=LA7MSGPROCESSED+1
  1.  . I (LA7MSGPROCESSED#10)=0 D CHKPROC
  1.  ;
  1.  K ^TMP("LA7TREE",$J)
  1.  ;
  1.  D CHKPROC
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CHKPROC ; Check if any processing routine need to be tasked to process info in LAH
  1.  ;
  1.  ; If point of care interface then task job(s) to process results in LAH.
  1.  I LA7INTYP>19,LA7INTYP<30,$D(LA7INTYP("LWL")) D
  1.  . I $G(ZTSTOP)=1 Q
  1.  . S LA7I=0
  1.  . F  S LA7I=$O(LA7INTYP("LWL",LA7I)) Q:'LA7I  D
  1.  . . D QLAH(LA7I,"EN^LRVRPOC")
  1.  . . K LA7INTYP("LWL",LA7I)
  1.  ;
  1.  ; If universal interface and auto-release turned on then task job(s) to process results in LAH. ;**88
  1.  I LA7INTYP=1,$D(LA7INTYP("LWL")) D
  1.  . I $G(ZTSTOP)=1 Q
  1.  . S LA7I=0
  1.  . F  S LA7I=$O(LA7INTYP("LWL",LA7I)) Q:'LA7I  D
  1.  . . D QLAH(LA7I,"EN^LRVRAR")
  1.  . . K LA7INTYP("LWL",LA7I)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. QUE ; Call here to queue this processing routine to run in the background.
  1.  ; Required variables are:  LA76248 = pointer to configuration in 62.48
  1.  ;
  1.  ; Check if we recently tasked the processing routine for this configuration.
  1.  ; Done to avoid repetitive locking attempts on each new message since the
  1.  ; FileMan locking API uses a site-defined timeout which is usually 3 seconds
  1.  ; but can be more. Slows down the interface if on each message we are waiting
  1.  ; 3 or more seconds for the lock to find out if the processing routine is already
  1.  ; running.
  1.  N LA7X,LA7Y
  1.  S LA7X=$H,LA7Y=$G(^XTMP("LA7VIN",LA76248))
  1.  I $P(LA7X,",")=$P(LA7Y,","),($P(LA7X,",",2)-$P(LA7Y,",",2))<240 Q
  1.  ;
  1.  ; See if already running
  1.  L +^LAHM(62.48,"Z",LA76248):DILOCKTM
  1.  I '$T Q
  1.  ;
  1.  N ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTSK
  1.  S ZTRTN="EN^LA7VIN",ZTDTH=$H,ZTIO=""
  1.  S ZTDESC="Processing Routine for "_$P(^LAHM(62.48,LA76248,0),"^")
  1.  S ZTSAVE("LA76248")=LA76248
  1.  D ^%ZTLOAD
  1.  ;
  1.  D XTMP
  1.  ;
  1.  L -^LAHM(62.48,"Z",LA76248)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. 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
  1.  ;         ZTRTN = name of processing routine to task
  1.  ;
  1.  ;
  1.  ; See if already running
  1.  L +^LAH("Z",LWL):DILOCKTM
  1.  I '$T Q
  1.  L -^LAH("Z",LWL)
  1.  ;
  1.  N ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
  1.  S ZTDTH=$H,ZTIO="",ZTDESC="Result Processing for "_$P(^LRO(68.2,LWL,0),"^")
  1.  S ZTSAVE("LRLL")=LWL
  1.  D ^%ZTLOAD
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CHECKTM ; Check is LA7TASK NIGHTY is scheduled in TaskMan.
  1.  ;
  1.  N LA7TSK,LA7J,MSG,NOW,OK
  1.  S (LA7TSK,OK)=0
  1.  D OPTSTAT^XUTMOPT("LA7TASK NIGHTY",.LA7TSK)
  1.  ;
  1.  ; If scheduled check to see if for the future
  1.  I LA7TSK>0 D
  1.  . S LA7J=0,NOW=$$NOW^XLFDT
  1.  . F  S LA7J=$O(LA7TSK(LA7J)) Q:'LA7J  I $P(LA7TSK(LA7J),"^",2)>NOW S OK=1 Q
  1.  I OK Q
  1.  ;
  1.  ; Option is not scheduled - send alert to G.LAB MESSAGING
  1.  S MSG="Lab Messaging - Option LA7TASK NIGHTY is not scheduled in TaskMan^LA7-MESSAGE-CHECKTM"
  1.  D XQA^LA7UXQA(0,LA76248,0,0,MSG,"",0)
  1.  Q
  1.  ;
  1.  ;
  1. CHECKMG ; Check if LAB MESSAGING mail group has active members.
  1.  ;
  1.  N XMERR,XQA,XQAID,XQAMSG
  1.  ;
  1.  ; See if mail group check has been done today
  1.  I $P($G(^XTMP("LA7CHECKMG",0)),"^",2)=DT Q
  1.  ;
  1.  ; Set flag that we've check the membership today.
  1.  S ^XTMP("LA7CHECKMG",0)=DT_"^"_DT_"^LAB HL7 CHECK LAB MESSAGING MAIL GROUP MEMBERS"
  1.  ;
  1.  K ^TMP("XMERR",$J)
  1.  I $$GOTLOCAL^XMXAPIG("LAB MESSAGING") Q
  1.  ;
  1.  ; Mail group has no active members
  1.  S XQAMSG="Lab Messaging - Mail group LAB MESSAGING has no active members"
  1.  ; Delete previous alerts
  1.  S XQAID="LA7-MESSAGE-CHECKMG"
  1.  D DEL^LA7UXQA(XQAID)
  1.  ;
  1.  ; Send alert to holders of mail group LMI
  1.  I $$GOTLOCAL^XMXAPIG("LMI") D  Q
  1.  . S XQA("G.LMI")=""
  1.  . D SETUP^XQALERT
  1.  . K ^TMP("XMERR",$J)
  1.  ;
  1.  ; Neither LAB MESSAGING or LMI mail groups have active members - send alert to holders of LRLIASON security key
  1.  S XQAMSG="Lab Messaging - Mail groups LAB MESSAGING and LMI have no active members"
  1.  M XQA=^XUSEC("LRLIASON")
  1.  D SETUP^XQALERT
  1.  K ^TMP("XMERR",$J)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. XTMP ; Set/update XTMP with current run time of this processing routine
  1.  ;
  1.  S ^XTMP("LA7VIN",0)=DT_"^"_DT_"^LAB HL7 PROCESS TASKING"
  1.  S ^XTMP("LA7VIN",LA76248)=$H
  1.  Q