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

LA7QRY1.m

Go to the documentation of this file.
  1. LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;June 23, 2008
  1. ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,68**;Sep 27, 1994;Build 56
  1. ;
  1. ; Reference to ADM^VADPT2 supported by DBIA #325
  1. ; Reference to BLDPID^VAFCQRY supported by DBIA #3630
  1. Q
  1. ;
  1. CHKSC ; Check search NLT/LOINC codes
  1. ;
  1. N J
  1. ;
  1. S J=0
  1. F S J=$O(LA7SCDE(J)) Q:'J D
  1. . N X
  1. . S X=LA7SCDE(J)
  1. . I $P(X,"^",2)="NLT",$D(^LAM("E",$P(X,"^"))) D Q
  1. . . S ^TMP("LA7-NLT",$J,$P(X,"^"))=""
  1. . I $P(X,"^",2)="LN",$D(^LAB(95.3,$P($P(X,"^"),"-"))) D Q
  1. . . S ^TMP("LA7-LN",$J,$P($P(X,"^"),"-"))=""
  1. . S LA7QERR(6)="Unknown search code "_$P(X,"^")_" passed"
  1. . K LA7SCDE(J)
  1. Q
  1. ;
  1. ;
  1. SPEC ; Convert HL7 Specimen Codes to File #61, Topography codes
  1. ; Find all topographies that use this HL7 specimen code
  1. N J,K,L
  1. ;
  1. S J=0
  1. F S J=$O(LA7SPEC(J)) Q:'J D
  1. . S K=LA7SPEC(J),L=0
  1. . F S L=$O(^LAB(61,"HL7",K,L)) Q:'L S ^TMP("LA7-61",$J,L)=""
  1. Q
  1. ;
  1. ;
  1. BUILDMSG ; Build HL7 message with result of query
  1. ;
  1. I $G(LA7NOMSG)=1 N HL,HLECH,HLFS,HLQ,LA7ECH,LA7FS,LA7MSH
  1. N LA,LA763,LA7ID,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7QUIT,LA7ROOT,LA7X,LRIDT,LRPOC,LRSS,X
  1. ;
  1. ; Create dummy MSH to pass HL7 delimiters
  1. I $G(LA7NOMSG)=1 D
  1. . I $L($G(LA7HL7))'=5 S LA7HL7="|^\~&"
  1. . S (HL("FS"),HLFS,LA7FS)=$E(LA7HL7),(HL("ECH"),HLECH,LA7ECH)=$E(LA7HL7,2,5)
  1. . S (HLQ,HL("Q"))=""
  1. . S LA7MSH(0)="MSH"_LA7FS_LA7ECH_LA7FS
  1. . S $P(LA7MSH(0),LA7FS,7)=$$FMTHL7^XLFDT($$NOW^XLFDT)_LA7FS
  1. . D FILESEG^LA7VHLU(GBL,.LA7MSH)
  1. ;
  1. F X="AUTO-INST","LRDFN","LRIDT","SUB","HUID","NLT","RUID","SITE" S LA(X)=""
  1. ;
  1. ; Find POC user to identify those specimens that are POC.
  1. S LRPOC=$$FIND1^DIC(200,"","OX","LRLAB,POC","B","")
  1. ;
  1. ; Take search results and put in HL7 message structure
  1. S LA7ROOT="^TMP(""LA7-QRY"",$J)",(LA7QUIT,LA7PIDSN)=0,LA7ID="LA7QRY-O-"
  1. F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT="" D Q:LA7QUIT
  1. . I $QS(LA7ROOT,1)'="LA7-QRY"!($QS(LA7ROOT,2)'=$J) S LA7QUIT=1 Q
  1. . I LA("LRDFN")'=$QS(LA7ROOT,3) D PAT
  1. . I LA("LRIDT")'=$QS(LA7ROOT,4) D
  1. . . I $G(LA7INTYP)=30,$G(LA7OBRSN) D PAT
  1. . . D ORC
  1. . I LA("SUB")'=$QS(LA7ROOT,5) D
  1. . . I $G(LA7INTYP)=30,$G(LA7OBRSN) D PAT
  1. . . D ORC
  1. . I LA("NLT")'=$P($QS(LA7ROOT,6),"!") D ORC
  1. . D OBX
  1. ;
  1. Q
  1. ;
  1. ;
  1. PAT ; Build PID/PV1 segments
  1. ;
  1. N I,LA7,LA7ERR,LA7PID,LA7PV1,VADMVT,VAINDT
  1. ;
  1. S (LA("LRDFN"),LRDFN)=$QS(LA7ROOT,3)
  1. S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
  1. D DEM^LRX
  1. ;
  1. ; Build PID segment
  1. S LA7PIDSN=LA7PIDSN+1
  1. ;
  1. ; Check if this field has been built previously for this patient
  1. ; Save this field to TMP global to use for subsequent calls.
  1. I $D(^TMP($J,"LA7VHLU","PID",DFN,LA7FS_LA7ECH)) D
  1. . M LA7PID=^TMP($J,"LA7VHLU","PID",DFN,LA7FS_LA7ECH)
  1. . S $P(LA7PID(0),LA7FS,2)=LA7PIDSN
  1. E D
  1. . D BLDPID^VAFCQRY(DFN,LA7PIDSN,"ALL",.LA7,.HL,.LA7ERR)
  1. . S I=0
  1. . F S I=$O(LA7(I)) Q:'I S LA7PID(I-1)=LA7(I)
  1. . M ^TMP($J,"LA7VHLU","PID",DFN,LA7FS_LA7ECH)=LA7PID
  1. ;
  1. D FILESEG^LA7VHLU(GBL,.LA7PID)
  1. I '$G(LA7NOMSG),$G(LA76249) D FILE6249^LA7VHLU(LA76249,.LA7PID)
  1. ;
  1. ; Build PV1 segment if building message for HDR and other subscribers
  1. I $G(LA7INTYP)=30 D PV1
  1. ;
  1. S (LA7OBRSN,LA7OBXSN,LA7NTESN)=0,(LA("LRIDT"),LA("SUB"))=""
  1. Q
  1. ;
  1. ;
  1. ORC ; Build ORC segment
  1. ;
  1. N LA764,LA7NLT,LRNMSP,X
  1. ;
  1. S (LA("LRIDT"),LRIDT)=$QS(LA7ROOT,4),(LA("SUB"),LRSS)=$QS(LA7ROOT,5)
  1. S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
  1. S X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"ORU"))
  1. S LA("HUID")=$P(X,"^"),LRNMSP="LR"
  1. I LA("HUID")="" S LA("HUID")=$P(LA763(0),"^",6)
  1. S LA("HUID","NMSP")=LRNMSP
  1. I "CHMI"[LA("SUB") S LA("HUID","SITE")=$P(LA763(0),"^",14)
  1. E S LA("HUID","SITE")=""
  1. ;
  1. S LA("RUID")=$P(X,"^",5),LRNMSP="LR"
  1. I LRPOC,LRPOC=$P(X,"^",4) S LRNMSP="LRPOC"
  1. S LA("RUID","NMSP")=LRNMSP
  1. S LA("RUID","SITE")=$P(X,"^",3)
  1. I LA("RUID")="" D
  1. . S LA("RUID")=LA("HUID")
  1. . S LA("RUID","NMSP")=LA("HUID","NMSP")
  1. . S LA("RUID","SITE")=LA("HUID","SITE")
  1. ;
  1. S LA("SITE")=$P(X,"^",2)
  1. S LA7NVAF=$$NVAF^LA7VHLU2(0),LA7NTESN=0
  1. ;
  1. S (LA("NLT"),LA7NLT)=$P($QS(LA7ROOT,6),"!"),(LA764,LA("ORD"))=""
  1. I LA7NLT'="" D
  1. . S LA764=+$O(^LAM("E",LA7NLT,0))
  1. . I LA764 S LA("ORD")=$$GET1^DIQ(64,LA764_",",.01)
  1. ;
  1. D ORC^LA7VORU,OBR
  1. ;
  1. Q
  1. ;
  1. ;
  1. OBR ; Build OBR segment
  1. ;
  1. N LA7RS
  1. ;
  1. I LA("SUB")="CH" D
  1. . D OBR^LA7VORU
  1. . D NTE^LA7VORU
  1. . S LA7OBXSN=0
  1. ;
  1. Q
  1. ;
  1. ;
  1. OBX ; Build OBX segment
  1. ;
  1. N LA7DATA,LA7VT
  1. ;
  1. S LA7NTESN=0
  1. I LA("SUB")="MI" D MI^LA7VORU1 Q
  1. I "CYEMSP"[LA("SUB") D AP^LA7VORU2 Q
  1. ;
  1. S LA7VT=$QS(LA7ROOT,7)
  1. D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LA7VT,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH)
  1. I '$D(LA7DATA) Q
  1. D FILESEG^LA7VHLU(GBL,.LA7DATA)
  1. I '$G(LA7NOMSG),$G(LA76249) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
  1. ; Send any test interpretation from file #60
  1. D INTRP^LA7VORUA
  1. ;
  1. ; Mark result as sent - set to 1, if corrected results set to 2
  1. I LA("SUB")="CH" D
  1. . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
  1. . S $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)=$S($P(LA7VT,"^",2)="C":2,1:1)
  1. ;
  1. Q
  1. ;
  1. ;
  1. PV1 ; Build PV1 segment for HDR
  1. N LA7DT,LA7PCE,LA7SDENC,LRDX,LRIDT,LRSS,LRUID,VADMVT,VAINDT
  1. S LRIDT=$QS(LA7ROOT,4),LRSS=$QS(LA7ROOT,5),LA7DT=0
  1. I LRIDT,LRSS'="" S LA7DT=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^")
  1. I 'LA7DT Q
  1. ;
  1. S LRDX=""
  1. ; Determine if an inpatient at time of specimen and build inpatient PV1.
  1. S VAINDT=LA7DT D ADM^VADPT2
  1. I VADMVT S LA7PV1(0)=$$IN^VAFHLPV1(DFN,LA7DT,",3,6,7,10,18,21,36,39,44,45,",VADMVT,"",1,LRDX)
  1. ;
  1. ; If not an inpatient then build outpatient PV1.
  1. I 'VADMVT D
  1. . N LA7VPTR
  1. . S LA7PCE=$$PCENC^LA7VHLU3(LRDFN,LRSS,LRIDT),LA7VPTR=""
  1. . I LA7PCE'="" D
  1. . . S LA7SDENC=$$SDENC^LA7VHLU3(LA7PCE)
  1. . . I LA7SDENC'="" S LA7VPTR=LA7SDENC_";SCE("
  1. . I LA7VPTR="" S LA7VPTR=DFN_";DPT("
  1. . S LA7PV1(0)=$$OUT^VAFHLPV1(DFN,"",LA7DT,LA7VPTR,"A",1)
  1. ;
  1. D FILESEG^LA7VHLU(GBL,.LA7PV1)
  1. I '$G(LA7NOMSG),$G(LA76249) D FILE6249^LA7VHLU(LA76249,.LA7PV1)
  1. Q