lab changes for RPMS - LOINC codes from V Lab file
This commit is contained in:
george
parent
3ad9f81035
commit
02fc269be1
|
|
@ -29,7 +29,7 @@ C0CFM2 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||||
;
|
;
|
||||||
RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
|
RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
|
||||||
;
|
;
|
||||||
I '$D(RIMBASE) D ASETUP^GPLRIMA ; FOR COMMAND LINE CALLS
|
I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
|
||||||
N ZI,ZJ,ZC,ZPATBASE
|
N ZI,ZJ,ZC,ZPATBASE
|
||||||
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
|
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
|
||||||
S ZI=""
|
S ZI=""
|
||||||
|
|
@ -40,7 +40,7 @@ RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
|
||||||
;
|
;
|
||||||
PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
|
PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
|
||||||
;
|
;
|
||||||
S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
|
S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
|
||||||
I '$D(ZWHICH) S ZWHICH="ALL"
|
I '$D(ZWHICH) S ZWHICH="ALL"
|
||||||
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
|
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
|
||||||
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
|
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
|
||||||
|
|
@ -123,7 +123,8 @@ PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
||||||
. . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
|
. . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
|
||||||
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
|
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
|
||||||
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=@ZVALS@(ZC0CI)
|
. . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
|
||||||
|
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
|
||||||
. E D ; THIS IS A SUBELEMENT
|
. E D ; THIS IS A SUBELEMENT
|
||||||
. . ;PUT THE FOLLOWING BACK TO USE RECURSION
|
. . ;PUT THE FOLLOWING BACK TO USE RECURSION
|
||||||
. . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
|
. . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,106 @@
|
||||||
|
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 12, 2009
|
||||||
|
;;5.2;;****;Sep 27, 1994
|
||||||
|
;
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for Lab Result Query
|
||||||
|
;
|
||||||
|
;
|
||||||
|
K ^TMP("C0C-VLAB",$J)
|
||||||
|
;
|
||||||
|
; Check and retrieve lab results from LAB DATA file (#63)
|
||||||
|
D GCPR^LA7QRY(C0CPTID,C0CSDT,C0CEDT,.C0CSC,.C0CSPEC,.C0CERR,C0CDEST,C0CHL7)
|
||||||
|
;
|
||||||
|
; If V LAB file present then check for lab results that are only in this file
|
||||||
|
I $D(^AUPNVLAB) D VCHECK
|
||||||
|
;
|
||||||
|
; If results found in V Lab file then build results and add to above results.
|
||||||
|
I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
|
||||||
|
;
|
||||||
|
;K ^TMP("C0C-VLAB",$J)
|
||||||
|
;
|
||||||
|
Q C0CDEST
|
||||||
|
;
|
||||||
|
;
|
||||||
|
VCHECK ; If V LAB file present then check for lab results that are only in this file.
|
||||||
|
;
|
||||||
|
N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SCRC,LA7SPEC,TMP
|
||||||
|
;
|
||||||
|
S LA7PTID=C0CPTID
|
||||||
|
D PATID^LA7QRY2
|
||||||
|
I $D(LA7ERR) Q
|
||||||
|
;
|
||||||
|
; Resolve search codes to lab datanames
|
||||||
|
S LA7SCSRC=$G(C0CSC)
|
||||||
|
S TMP=$$SCLIST^LA7QRY2(LA7SCSRC)
|
||||||
|
Q:$D(LA7ERR) ""
|
||||||
|
S LA7SC=TMP D:LA7SC'="*" CHKSC^LA7QRY1
|
||||||
|
;
|
||||||
|
; Convert specimen codes to file #61 Topography entries
|
||||||
|
S LA7SPEC=$G(C0CSPEC)
|
||||||
|
I LA7SPEC'="*" D SPEC^LA7QRY1
|
||||||
|
;
|
||||||
|
S C0CROOT="^AUPNVLAB(""ALR4"",DFN,COCSDT)",C0CEND=0
|
||||||
|
;
|
||||||
|
F S C0CROOT=$Q(@C0CROOT) Q:C0CROOT="" D Q:C0CEND
|
||||||
|
. I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q ; Left x-ref or patient
|
||||||
|
. I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q ; Exceeded end date/time
|
||||||
|
. S C0CDA=$QS(C0CROOT,6)
|
||||||
|
. I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q ; Already checked during scan of file #63
|
||||||
|
. D VCHK1
|
||||||
|
;
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
VBUILD ; Build results found only in V LAB file into HL7 structure.
|
||||||
|
;
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a result in file #63.
|
||||||
|
; Call from LA7QRY2
|
||||||
|
;
|
||||||
|
N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,X
|
||||||
|
;
|
||||||
|
S DFN=$P(^LR(LRDFN,0),"^",3)
|
||||||
|
S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0)
|
||||||
|
S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6)
|
||||||
|
;
|
||||||
|
; ^AUPNVLAB("ALR1",5380,3080307.211055,"EKT 0307 48",188,5427202)=""
|
||||||
|
;
|
||||||
|
S C0C60=0,C0CLN=""
|
||||||
|
F S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60 D Q:C0CLN'=""
|
||||||
|
. S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CDT,C0CACC,C0C60,0))
|
||||||
|
. I C0CDA<1 Q
|
||||||
|
. S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
|
||||||
|
. S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
|
||||||
|
. S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CLN_"^"_C0CDA
|
||||||
|
;
|
||||||
|
; If LOINC found then update variable with LN code
|
||||||
|
I C0CLN'="" D
|
||||||
|
. S X=$P(LA7X,"^",3)
|
||||||
|
. S $P(X,"!",3)=C0CLN
|
||||||
|
. S $P(LA7X,"^",3)=X
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
VCHK1 ; Check the entry in V Lab to determine if it meets criteria
|
||||||
|
;
|
||||||
|
N C0CVLAB,I
|
||||||
|
;
|
||||||
|
F I=0,12 S C0CVLAB(I)=^AUPNVLAB(C0CDA,I)
|
||||||
|
;
|
||||||
|
D VSTORE
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
VSTORE ; Store entry for building in HL7 message when parent is from V LAB file.
|
||||||
|
;
|
||||||
|
S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(12),"^"),$P(C0CVLAB,"^",2))=""
|
||||||
|
Q
|
||||||
|
|
@ -0,0 +1,194 @@
|
||||||
|
LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ;1/30/07 19:05
|
||||||
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,69,73**;Sep 27, 1994;Build 7
|
||||||
|
; JMC - mods to check for IHS V LAB file
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
PATID ; Resolve patient id and establish patient environment
|
||||||
|
;
|
||||||
|
N LA7X
|
||||||
|
;
|
||||||
|
S (DFN,LRDFN)="",LA7PTYP=0
|
||||||
|
; VOE changes, Use HRN cross reference, Daou;;June 8,2005
|
||||||
|
S LA7X=$O(^AUPNPAT("D",LA7PTID,""))
|
||||||
|
I LA7X>0 D SETDFN(LA7X) S LA7PTYP=1
|
||||||
|
;
|
||||||
|
; See if SSN passed as patient identifier
|
||||||
|
I DFN'>0 S LA7X=$O(^DPT("SSN",LA7PTID,0)) I LA7X>0 D SETDFN(LA7X) S LA7PTYP=1
|
||||||
|
;
|
||||||
|
; MPI/ICN (integration control number) passed as patient identifier
|
||||||
|
I DFN'>0 S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V")) I LA7X>0 D SETDFN(LA7X) S LA7PTYP=2
|
||||||
|
;
|
||||||
|
; If no patient identified/no laboratory record - return exception message
|
||||||
|
I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed"
|
||||||
|
I 'DFN S LA7ERR(2)="No patient found with requested identifier"
|
||||||
|
I DFN,'LRDFN S LA7ERR(3)="No laboratory record for requested patient"
|
||||||
|
I LRDFN,'$D(^LR(LRDFN)) S LA7ERR(4)="Database error - missing laboratory record for requested patient"
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
BCD ; Search by specimen collection date.
|
||||||
|
;
|
||||||
|
N LA763,LA7QUIT
|
||||||
|
;
|
||||||
|
S (LA7SDT(0),LA7EDT(0))=0
|
||||||
|
I LA7SDT S LA7SDT(0)=9999999-LA7SDT
|
||||||
|
I LA7EDT S LA7EDT(0)=9999999-LA7EDT
|
||||||
|
;
|
||||||
|
S LRSS=""
|
||||||
|
F S LRSS=$O(LRSSLST(LRSS)) Q:LRSS="" D
|
||||||
|
. S (LA7QUIT,LRIDT)=0
|
||||||
|
. I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1)
|
||||||
|
. F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LA7QUIT D
|
||||||
|
. . ; Quit if reached end of data or outside date criteria
|
||||||
|
. . I 'LRIDT!(LRIDT>LA7SDT(0)) S LA7QUIT=1 Q
|
||||||
|
. . D SEARCH
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
BRAD ; Search by results available date (completion date).
|
||||||
|
; Assumes cross-references still exist for dates in LRO(69) global.
|
||||||
|
; Collects specimen date/time values for a given LRDFN and completion date.
|
||||||
|
; Cross-reference is by date only, time stripped from start date.
|
||||||
|
; Uses cross-reference ^LRO(69,DT,1,"AN",'LOCATION',LRDFN,LRIDT)=""
|
||||||
|
;
|
||||||
|
N LA763,LA7DT,LA7ROOT,LA7SRC,X
|
||||||
|
;
|
||||||
|
; Check if orders still exist Iin file #69 for search range
|
||||||
|
S LA7SDT(1)=(LA7SDT\1)-.0000000001,LA7EDT(1)=(LA7EDT\1)+.24,LA7SRC=0
|
||||||
|
S X=$O(^LRO(69,LA7SDT(1)))
|
||||||
|
I X,X<LA7EDT(1) S LA7SRC=1
|
||||||
|
;
|
||||||
|
; Search "AN" cross-reference in file #69.
|
||||||
|
I LA7SRC D
|
||||||
|
. S LA7DT=LA7SDT(1)
|
||||||
|
. F S LA7DT=$O(^LRO(69,LA7DT)) Q:'LA7DT!(LA7DT>LA7EDT(1)) D
|
||||||
|
. . S LA7ROOT="^LRO(69,LA7DT,1,""AN"")"
|
||||||
|
. . F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN") D
|
||||||
|
. . . I $QS(LA7ROOT,6)'=LRDFN Q
|
||||||
|
. . . S LRIDT=$QS(LA7ROOT,7),LRSS=""
|
||||||
|
. . . F S LRSS=$O(LRSSLST(LRSS)) Q:LRSS="" D SEARCH
|
||||||
|
;
|
||||||
|
; If no orders in #69 then do long search through file #63.
|
||||||
|
I 'LA7SRC D
|
||||||
|
. S LRSS=""
|
||||||
|
. F S LRSS=$O(LRSSLST(LRSS)) Q:LRSS="" D
|
||||||
|
. . S LRIDT=0
|
||||||
|
. . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT D
|
||||||
|
. . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
|
||||||
|
. . . I $P(LA763(0),"^",3)>LA7SDT(1),$P(LA763(0),"^",3)<LA7EDT(1) D SEARCH
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
SEARCH ; Search subscript for a specific collection date/time
|
||||||
|
;
|
||||||
|
K LA763
|
||||||
|
S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
|
||||||
|
;
|
||||||
|
; Only CH, MI, and BB subscripts store pointer to file #61 in 5th piece of zeroth node.
|
||||||
|
; Quit if specific specimen codes and they do not match
|
||||||
|
I "CHMIBB"[LRSS S LA761=+$P(LA763(0),"^",5)
|
||||||
|
E S LA761=0
|
||||||
|
I LA761,$D(^TMP("LA7-61",$J)),'$D(^TMP("LA7-61",$J,LA761)) Q
|
||||||
|
;
|
||||||
|
; --- Chemistry
|
||||||
|
I LRSS="CH" D CHSS Q
|
||||||
|
; --- Microbiology
|
||||||
|
I LRSS="MI" D MISS Q
|
||||||
|
; --- Surgical pathology
|
||||||
|
I LRSS="SP" D APSS Q
|
||||||
|
; --- Cytology
|
||||||
|
I LRSS="CY" D APSS Q
|
||||||
|
; --- Electron Micrscopsy
|
||||||
|
I LRSS="EM" D APSS Q
|
||||||
|
; --- Autopsy
|
||||||
|
I LRSS="AU" D APSS Q
|
||||||
|
; --- Blood Bank
|
||||||
|
I LRSS="BB" D BBSS Q
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
CHSS ; Search "CH" datanames for matching codes
|
||||||
|
;
|
||||||
|
N LA7X,LRSB
|
||||||
|
;
|
||||||
|
S LRSB=1
|
||||||
|
F S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB D
|
||||||
|
. S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
|
||||||
|
. I $P($P(LA7X,"^",3),"!",3)="",$D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.
|
||||||
|
. S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761)
|
||||||
|
. D CHECK
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
MISS ; Search "MI" subscripts for matching codes
|
||||||
|
;
|
||||||
|
N LA7ND,LRSB
|
||||||
|
;
|
||||||
|
S LA7ND=0
|
||||||
|
F LA7ND=1,5,8,11,16 I $D(^LR(LRDFN,LRSS,LRIDT,LA7ND)) D
|
||||||
|
. S LRSB=$S(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
|
||||||
|
. S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LA761)
|
||||||
|
. D CHECK
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
APSS ; Search AP subscripts for matching codes
|
||||||
|
; AP results are currently not coded - use defaults
|
||||||
|
;
|
||||||
|
N LA7CODE,LRSB
|
||||||
|
;
|
||||||
|
S LRSB=.012
|
||||||
|
S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
|
||||||
|
D CHECK
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
BBSS ; Search BB subscript for matching codes
|
||||||
|
; *** This subscript currently not supported ***
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
CHECK ; Check NLT order/result and LOINC codes.
|
||||||
|
;
|
||||||
|
N LA7QUIT
|
||||||
|
;
|
||||||
|
; If wildcard then store
|
||||||
|
; Otherwise check for specific NLT order/result and LOINC codes
|
||||||
|
I LA7SC="*" D STORE Q
|
||||||
|
S LA7QUIT=0
|
||||||
|
F I=1:1:3 D Q:LA7QUIT
|
||||||
|
. ; If no test code then skip
|
||||||
|
. I '$L($P(LA7CODE,"!",I)) Q
|
||||||
|
. ; If test code does not match a search code then quit
|
||||||
|
. I '$D(^TMP($S(I=3:"LA7-LN",1:"LA7-NLT"),$J,$P(LA7CODE,"!",I))) Q
|
||||||
|
. D STORE S LA7QUIT=1
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
STORE ; Store entry for building in HL7 message
|
||||||
|
;
|
||||||
|
S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS,LA7CODE,LRSB)=""
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
SETDFN(LA7X) ; Setup DFN and other lab variables.
|
||||||
|
;
|
||||||
|
S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^")
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;***** SETUP THE SEARCH CODES
|
||||||
|
SCLIST(SCLST) ;
|
||||||
|
N I,RC,SCALL,TMP K LRSSLST
|
||||||
|
S SCALL=",CH,MI,SP,"
|
||||||
|
S SCLST=$$UP^XLFSTR($TR(SCLST," ")),RC="*"
|
||||||
|
S:SCLST?.1"*" RC=SCLST,SCLST=$P(SCALL,",",2,999)
|
||||||
|
F I=1:1 S TMP=$P(SCLST,",",I) Q:TMP="" D Q:$D(LA7ERR)>1
|
||||||
|
. I SCALL[(","_TMP_",") S LRSSLST(TMP)="" Q
|
||||||
|
. S LA7ERR(7)="Invalid list of subscripts: '"_SCLST_"'"
|
||||||
|
Q RC
|
||||||
|
|
@ -0,0 +1,129 @@
|
||||||
|
LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ;Apr 8, 2009
|
||||||
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,64,71**;Sep 27, 1994
|
||||||
|
; JMC - mods to check for IHS V LAB file
|
||||||
|
;
|
||||||
|
CH ; Observation/Result segment for "CH" subscript results.
|
||||||
|
; Called by LA7VOBX
|
||||||
|
;
|
||||||
|
N LA76304,LA7ALT,LA7DIV,LA7I,LA7RS,LA7X,LA7Y,X
|
||||||
|
;
|
||||||
|
; "CH" subscript requires a dataname
|
||||||
|
I '$G(LRSB) Q
|
||||||
|
;
|
||||||
|
; get result node from LR global.
|
||||||
|
S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
|
||||||
|
S LA7RS=$P(LRSB,"^",2),LRSB=$P(LRSB,"^")
|
||||||
|
S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
|
||||||
|
; If previous results have been corrected then send corrected status
|
||||||
|
I LA7RS="",$P(LA7VAL,"^",10)=2 S LA7RS="C"
|
||||||
|
;
|
||||||
|
; Check if test is OK to send - (O)utput or (B)oth
|
||||||
|
S LA7X=$P(LA7VAL,"^",12)
|
||||||
|
I LA7X]"","BO"'[LA7X Q
|
||||||
|
I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",7)) Q
|
||||||
|
;
|
||||||
|
; If no result NLT or LOINC try to determine from file #60
|
||||||
|
S LA7X=$P(LA7VAL,"^",3)
|
||||||
|
;
|
||||||
|
; Check for no LOINC in 63 and LOINC found in V LAB file.
|
||||||
|
I $P(LA7X,"!",3)="",$D(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) S $P(LA7X,"!",3)=$P(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB),"^")
|
||||||
|
;
|
||||||
|
I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
|
||||||
|
; No result NLT code - log error
|
||||||
|
I $P($P(LA7VAL,"^",3),"!",2)="" D
|
||||||
|
. N LA7X
|
||||||
|
. S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
|
||||||
|
. D CREATE^LA7LOG(36)
|
||||||
|
;
|
||||||
|
; something missing - No NLT code, etc.
|
||||||
|
I LA7VAL="" Q
|
||||||
|
;
|
||||||
|
; Check for missing units/reference ranges
|
||||||
|
S LA7X=$P(LA7VAL,"^",5)
|
||||||
|
;
|
||||||
|
; Results missing units, lookup in file #60
|
||||||
|
I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
|
||||||
|
;
|
||||||
|
; If results missing reference ranges, use values from file #60.
|
||||||
|
I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
|
||||||
|
. S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
|
||||||
|
. S $P(LA7X,"!",2)=$P(LA7Y,"^")
|
||||||
|
. S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
|
||||||
|
. S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
|
||||||
|
. S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
|
||||||
|
; Use therapeutic low/high if low/high missing.
|
||||||
|
I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
|
||||||
|
. S $P(LA7X,"!",2)=$P(LA7X,"!",11)
|
||||||
|
. S $P(LA7X,"!",3)=$P(LA7X,"!",12)
|
||||||
|
;
|
||||||
|
; Evaluate low/high reference ranges in case M code in these fields.
|
||||||
|
S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
|
||||||
|
F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
|
||||||
|
. S @("X="_$P(LA7X,"!",LA7I))
|
||||||
|
. S $P(LA7X,"!",LA7I)=X
|
||||||
|
;
|
||||||
|
; Put units/reference ranges back in variable LA7VAL
|
||||||
|
S $P(LA7VAL,"^",5)=LA7X
|
||||||
|
;
|
||||||
|
; Initialize OBX segment
|
||||||
|
S LA7OBX(0)="OBX"
|
||||||
|
S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
|
||||||
|
;
|
||||||
|
; Value type
|
||||||
|
; If result is "cancel" or "comment" then data type is ST - string data
|
||||||
|
S LA7X=$S("canccomment"[$P(LA7VAL,"^"):1,1:0)
|
||||||
|
I LA7X S LA7OBX(2)="ST"
|
||||||
|
E S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
|
||||||
|
;
|
||||||
|
; Observation identifer
|
||||||
|
; build alternate code based on dataname from file #63 in case it's needed
|
||||||
|
S LA7X=$P(LA7VAL,"^",3)
|
||||||
|
S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
|
||||||
|
S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Test value
|
||||||
|
; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD.
|
||||||
|
S LA7X=$P(LA7VAL,"^")
|
||||||
|
I LA7X'="canc",$$GET1^DID(63.04,LRSB,"","TYPE","","LA7ERR")="SET" D
|
||||||
|
. S LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)
|
||||||
|
. I LA7X="" S LA7X=$P(LA7VAL,"^")
|
||||||
|
I $G(LA7NVAF)=1,LA7X="canc" S LA7X="PL Cancelled"
|
||||||
|
S LA7OBX(5)=$$OBX5^LA7VOBX(LA7X,LA7OBX(2),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Units
|
||||||
|
S LA7X=$P(LA7VAL,"^",5)
|
||||||
|
S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Reference range
|
||||||
|
S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Abnormal flags
|
||||||
|
S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,"^",2))
|
||||||
|
;
|
||||||
|
; "P"artial or "F"inal results
|
||||||
|
S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F")
|
||||||
|
I LA7RS="C" S LA7X=LA7RS
|
||||||
|
S LA7OBX(11)=$$OBX11^LA7VOBX(LA7X)
|
||||||
|
;
|
||||||
|
; Observation date/time - collection date/time per HL7 standard
|
||||||
|
I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
|
||||||
|
;
|
||||||
|
S LA7DIV=$P(LA7VAL,"^",9)
|
||||||
|
I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
|
||||||
|
;
|
||||||
|
; Facility that performed the testing
|
||||||
|
S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Person that verified the test
|
||||||
|
S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Observation method
|
||||||
|
S LA7X=$P($P(LA7VAL,"^",3),"!",4)
|
||||||
|
I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Equipment entity identifier
|
||||||
|
I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
|
||||||
|
;
|
||||||
|
Q
|
||||||
Loading…
Reference in New Issue