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

LA7VIN1.m

Go to the documentation of this file. 
  1. LA7VIN1 ;DALOI/JMC - Process Incoming UI Msgs, continued ;04/06/16  15:51
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,74,88**;Sep 27, 1994;Build 10
  1.  ;
  1.  ; This routine is a continuation of LA7VIN and is only called from there.
  1.  ; It is called with each message found in the incoming queue.
  1.  Q
  1.  ;
  1. NXTMSG ;
  1.  N FDA,LA7ABORT,LA7AERR,LA7CNT,LA7END,LA7ERR
  1.  N LA7INDX,LA7KILAH,LA7QUIT,LA7SEG,LA7STYP
  1.  ;
  1.  S (LA7AERR,LA7ERR)=""
  1.  S (LA7ABORT,LA7CNT,LA7END,LA7INDX,LA7QUIT,LA7SEQ)=0
  1.  S DT=$$DT^XLFDT
  1.  S LA7ID="UNKNOWN-I-"
  1.  ;
  1.  ; Message built but no text.
  1.  I '$O(^LAHM(62.49,LA76249,150,0)) D  Q
  1.  . S (LA7ABORT,LA7ERR)=6
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  . D SETID^LA7VHLU1(LA76249,LA7ID,"UNKNOWN",1)
  1.  ;
  1.  ; Process message segments
  1.  ; Lab currently does not accept segments beginning with the letter "Z" which are reserved for locally-defined messages.
  1.  ; "Z" segments will be ignored by this software.
  1.  F  S LA7END=$$GETSEG^LA7VHLU2(LA76249,.LA7INDX,.LA7SEG) Q:LA7END!(LA7ABORT)  D
  1.  . S LA7STYP=$E(LA7SEG(0),1,3) ; Segment type
  1.  . I $E(LA7STYP,1)="Z" Q
  1.  . ; Not a valid segment type
  1.  . I LA7STYP'?2U1UN D  Q
  1.  . . S LA7ERR=34
  1.  . . D CREATE^LA7LOG(LA7ERR)
  1.  . ; Segment encoded wrong - field separator does not match
  1.  . I "MSH^FSH^BHS^"'[(LA7STYP_"^"),$E(LA7SEG(0),4)'=LA7FS D  Q
  1.  . . S LA7ERR=35
  1.  . . D CREATE^LA7LOG(LA7ERR)
  1.  . I $T(@LA7STYP)="" Q  ; No processing logic for this segment type
  1.  . D @LA7STYP
  1.  ;
  1.  ; Send HL7 Application Acknowledgment message for selected interfaces/message types
  1.  I LA7MTYP="ORM",LA7INTYP=10 D SENDACK
  1.  I LA7MTYP="ORU",LA7INTYP=1,LA7AAT(1)'="" D
  1.  . I $G(LA76249("AR")) Q  ; Auto Release will send application ACK.
  1.  . I LA7AAT(1)="NE" Q
  1.  . I LA7AAT(1)="SU",$G(LA7ERR)'="" Q
  1.  . I LA7AAT(1)="ER",$G(LA7ERR)="" Q
  1.  . D SENDACK
  1.  ;
  1.  ; Set id if only MSH segment received.
  1.  I LA7SEQ<5 D
  1.  . D SETID^LA7VHLU1(LA76249,LA7ID,"UNKNOWN",1)
  1.  ;
  1.  ; Set status to purgeable if no errors.
  1.  I $P($G(^LAHM(62.49,LA76249,0)),"^",3)'="E" D
  1.  . S FDA(1,62.49,LA76249_",",2)="X"
  1.  . D FILE^DIE("","FDA(1)","LA7ERR(1)")
  1.  ;
  1.  ; Store identifier's found in message.
  1.  D UPID^LA7VHLU1(LA76249)
  1.  ;
  1.  ; Send new result alert for ORU messages if turned on.
  1.  I $G(LA7MTYP)="ORU",$D(^LAHM(62.48,+$G(LA76248),20,"B",1)) D
  1.  . N LA7MSG,LA7ROOT
  1.  . S LA7ROOT="^TMP(""LA7-ORU"",$J)"
  1.  . F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  Q:$QS(LA7ROOT,1)'="LA7-ORU"!($QS(LA7ROOT,2)'=$J)  D
  1.  . . S LA7MSG(1)=$S($QS(LA7ROOT,5)="CH":"Chemistry/Hematology",$QS(LA7ROOT,5)="MI":"Microbiology",$QS(LA7ROOT,5)="SP":"Surgical Pathology",$QS(LA7ROOT,5)="CY":"Cytology",$QS(LA7ROOT,5)="EM":"Electron Microscopy",1:"")
  1.  . . I LA7MSG(1)'="" S LA7MSG(1)=" "_LA7MSG(1)
  1.  . . S LA7MSG="Lab Msg - New"_LA7MSG(1)_" results received for "_$P($G(^LAHM(62.48,$QS(LA7ROOT,3),0),"UNKNOWN"),"^")_"^"_$QS(LA7ROOT,5)
  1.  . . D XQA^LA7UXQA(1,$QS(LA7ROOT,3),"","",LA7MSG,"",0)
  1.  ;
  1.  ; Send new order alert for ORM messages if turned on.
  1.  I $G(LA7MTYP)="ORM",$D(^LAHM(62.48,+$G(LA76248),20,"B",3)) D
  1.  . N LA7ROOT
  1.  . S LA7ROOT="^TMP(""LA7-ORM"",$J)"
  1.  . F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  Q:$QS(LA7ROOT,1)'="LA7-ORM"!($QS(LA7ROOT,2)'=$J)  D
  1.  . . D XQA^LA7UXQA(3,$QS(LA7ROOT,3),"",$QS(LA7ROOT,4),"",$QS(LA7ROOT,5))
  1.  ;
  1.  ; Create performing lab comment for entries in LAH.
  1.  ;I $D(^TMP("LA7-PL-NTE",$J)) D PL^LA7VIN1B
  1.  ;
  1.  ; Cleanup shipping config test info used to process orders
  1.  I $G(LA7MTYP)="ORM" K ^TMP("LA7TC",$J)
  1.  ;
  1.  ; If amended results received then send bulletins
  1.  I $D(^TMP("LA7 AMENDED RESULTS",$J)) D SENDARB^LA7VIN1A
  1.  ;
  1.  ; If cancelled orders received then send bulletins
  1.  I $D(^TMP("LA7 ORDER STATUS",$J)) D SENDOSB^LA7VIN1B
  1.  ;
  1.  ; If units/normals changed then send bulletins
  1.  I $D(^TMP("LA7 UNITS/NORMALS CHANGED",$J)) D SENDUNCB^LA7VIN1A
  1.  ;
  1.  ; If abnormal/critical results then send bulletins
  1.  I $D(^TMP("LA7 ABNORMAL RESULTS",$J)) D SENDACB^LA7VIN1A
  1.  ;
  1.  ; If auto release move cross-references to ^LAH from ^TMP to signal available for processing if no error.
  1.  I $D(^TMP("LA7 AR",$J)),$P($G(^LAHM(62.49,LA76249,0)),"^",3)'="E" M ^LAH=^TMP("LA7 AR",$J)
  1.  ;
  1.  D KILLMSH
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. MSA ;; Process MSA segment
  1.  ;
  1.  D KILLMSA
  1.  ;
  1.  D MSA^LA7VIN3
  1.  ;
  1.  ; Set sequence flag
  1.  S LA7SEQ=5
  1.  Q
  1.  ;
  1.  ;
  1. BSH ;; Process various HL7 header segments
  1. FSH ;;
  1. MSH ;;
  1.  D KILLMSH
  1.  ;
  1.  D MSH^LA7VIN2
  1.  ;
  1.  ; Set sequence flag
  1.  S LA7SEQ=1
  1.  Q
  1.  ;
  1.  ;
  1. NTE ;; Process NTE segment
  1.  ;
  1.  I LA7SEQ<30 D  Q
  1.  . ; Put code to log error - no OBR/OBX segment
  1.  ;
  1.  ; Flag set that there was problem with OBR segment,
  1.  ; skip associated NTE segments that follow OBR/OBX segments
  1.  I LA7QUIT=2 Q
  1.  ;
  1.  I LA7MTYP="ORU" D NTE^LA7VIN2
  1.  I LA7MTYP="ORM" D NTE^LA7VIN2
  1.  I LA7MTYP="ORR" D NTE^LA7VIN2
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OBR ;; Process OBR segment
  1.  ;
  1.  D KILLOBR
  1.  ;
  1.  ; Clear flag to process this segment
  1.  I LA7QUIT>0 S LA7QUIT=0
  1.  ;
  1.  ; If not UI interface and no PID segment
  1.  I LA7INTYP'=1,LA7SEQ<10 D  Q
  1.  . S (LA7ABORT,LA7ERR)=46
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  I LA7MTYP="ORR" D OBR^LA7VIN4
  1.  I LA7MTYP="ORU" D OBR^LA7VIN4
  1.  I LA7MTYP="ORM" D OBR^LA7VORM
  1.  ;
  1.  ; Set sequence flag
  1.  S LA7SEQ=30
  1.  Q
  1.  ;
  1.  ;
  1. OBX ;; Process OBX segment
  1.  ;
  1.  D KILLOBX
  1.  ;
  1.  ; No OBR segment, can't process OBX
  1.  I LA7SEQ<30 D  Q
  1.  . S (LA7ABORT,LA7ERR)=9
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Flag set that there was problem with OBR segment,
  1.  ; skip associated OBX segments that follow OBR segment
  1.  I LA7QUIT=2 Q
  1.  ;
  1.  ; Process result messages (ORU).
  1.  I LA7MTYP="ORU" D
  1.  . I '$G(LA7ISQN) Q  ; No place to store results
  1.  . ; Process "CH" subscript results.
  1.  . I $G(LA7SS)="CH" D OBX^LA7VIN5
  1.  . ;
  1.  . ; Process AP subscripts results. "AU" not currently supported
  1.  . I $G(LA7SS)?1(1"SP",1"CY",1"EM") D OBX^LA7VIN7
  1.  . ;
  1.  . ; Process "MI" subscript results.
  1.  . I $G(LA7SS)="MI" D OBX^LA7VIN7
  1.  . ;
  1.  . ; Process "BB" subscript results - not supported
  1.  . ;
  1.  . ; Update test status on manifest
  1.  . I $G(LA7628),LA7UID'="",$G(LA7OTST) D UTS^LA7VHLU1(LA7628,LA7UID,LA7OTST)
  1.  ;
  1.  ; Process results that accompany orders
  1.  I LA7MTYP="ORM" D OBX^LA7VIN5
  1.  ;
  1.  ; Set sequence flag
  1.  S LA7SEQ=40
  1.  Q
  1.  ;
  1.  ;
  1. ORC ;; Process ORC segment
  1.  ;
  1.  D KILLORC
  1.  ;
  1.  ; If not UI interface and no PID segment
  1.  I LA7INTYP'=1,LA7SEQ<10 D  Q
  1.  . S (LA7ABORT,LA7ERR)=46
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  D ORC^LA7VIN2
  1.  ;
  1.  ; Set sequence flag
  1.  S LA7SEQ=20
  1.  Q
  1.  ;
  1.  ;
  1. PID ;; Process PID segment
  1.  ;
  1.  D KILLPID
  1.  ;
  1.  ; no MSH segment
  1.  I LA7SEQ<1 D  Q
  1.  . S (LA7ABORT,LA7ERR)=7
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Clear flag to process this segment
  1.  I LA7QUIT=1 S LA7QUIT=0
  1.  ;
  1.  D PID^LA7VIN2
  1.  ;
  1.  ; Set sequence flag
  1.  S LA7SEQ=10
  1.  Q
  1.  ;
  1.  ;
  1. PV1 ;; Process PV1 segment
  1.  ;
  1.  D KILLPV1
  1.  ;
  1.  ; no PID segment
  1.  I LA7SEQ<10 D  Q
  1.  . S (LA7ABORT,LA7ERR)=46
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  D PV1^LA7VIN2
  1.  ;
  1.  ; Set sequence flag
  1.  S LA7SEQ=11
  1.  Q
  1.  ;
  1.  ;
  1. SENDACK ; Send HL7 Application Acknowledgment message for selected interfaces/message types
  1.  ;
  1.  ;ZEXCEPT: LA7624,LA76248,LA76249,LA7AERR,LA7ERR,LA7UID,PNM,SSN
  1.  ;
  1.  N LA
  1.  S LA(62.48)=LA76248,LA(62.49)=LA76249
  1.  I $G(LA7624) S LA(62.4)=LA7624
  1.  S LA("ACK")=$S(+LA7ERR:"AE",1:"AA")
  1.  I $G(LA7UID)'="" S LA("ID",1)=LA7UID
  1.  I $G(LA7PNM)'="" S LA("ID",2)=LA7PNM
  1.  I $G(LA7SSN)'="" S LA("ID",3)=LA7SSN
  1.  I LA7AERR="" S LA7AERR=LA7ERR
  1.  I LA7AERR>0,$P(LA7AERR,"^",2)="" S $P(LA7AERR,"^",2)="See VistA Lab Universal Interface Log for specific error"
  1.  S LA("MSG")=$P(LA7AERR,"^",2)
  1.  ;
  1.  ; Build info for ERR segment
  1.  D BLDERR^LA7VHLU8(.LA,LA7AERR)
  1.  ;
  1.  D ACK^LA7VHLU8(.LA)
  1.  Q
  1.  ;
  1.  ;
  1.  ; The section below is designed to clean up variables that are created during the processing of a segment type
  1.  ; and any created by processing of segments that are within the message definition.
  1.  ;
  1. KILLMSH ; Clean up variables used by MSH and following segments
  1.  K LA7AAT,LA7CSITE,LA7CS,LA7ECH,LA7FS,LA7HLV,LA7MEDT,LA7MID,LA7MTYP
  1.  K LA7RAP,LA7RFAC,LA7SAP,LA7SEQ,LA7SFAC
  1.  K ^TMP("LA7 AR",$J),^TMP("LA7-ID",$J),^TMP("LA7-ORM",$J),^TMP("LA7-ORU",$J),^TMP("LA7-PL-NTE",$J)
  1.  ;
  1. KILLMSA ; Clean up variables used by MSA and following segments
  1.  K LA7MSATM
  1.  ;
  1. KILLPID ; Clean up variables used by PID and following segments
  1.  K DFN
  1.  K LA7DOB,LA7ICN,LA7PNM,LA7PRACE,LA7PTID2,LA7PTID3,LA7PTID4
  1.  K LA7SEX,LA7SPID,LA7SSN
  1.  K LRDFN,LRTDFN
  1.  ;
  1. KILLPV1 ; Clean up variables used by PV1 and following segments
  1.  K LA7LOC,LA7SPV1,LAPSUBID
  1.  ;
  1. KILLORC ; Clean up variables used by ORC and following segments
  1.  K LA7628,LA7629
  1.  K LA7CSITE,LA7DUR,LA7DURU,LA7ODUR,LA7ODURU,LA7EOL,LA7OCR,LA7ORDT
  1.  K LA7OTYPE,LA7OUR,LA7PEB,LA7PON,LA7POP,LA7PVB,LA7SM
  1.  ;
  1. KILLOBR ; Clean up variables used by OBR and following segments
  1.  K LA70070,LA760,LA761,LA762,LA7624,LA7696
  1.  K LA7AA,LA7AD,LA7ACC,LA7AN,LA7ARI,LA7CDT,LA7FID,LA7ISQN,LA7LWL,LA7ONLT,LA7OTST
  1.  K LA7POC,LA7PRI,LA7RSDT,LA7SAC,LA7SID,LA7SOBR,LA7SPEC,LA7SPTY,LA7SS,LA7TECH,LA7UID,LA7UR
  1.  K LA7OBR25,LA7OBR26,LA7OBR29,LA7OBR32,LA7OBR33,LA7OBR34,LA7OBR49,LA7VPSTG
  1.  ;
  1. KILLOBX ; Clean up variables used by OBX and following segments
  1.  K LA7AUTORELEASE,LA7ORS,LA7PRODID,LA7RLNC,LA7RMK,LA7RNLT,LA7RO,LA7SOBX,LA7SUBID
  1.  ;
  1. KILLBLG ; Clean up variables used by BLG and following segments
  1.  ;
  1.  Q