rollback of Lab for RPMS code
This commit is contained in:
george
parent
02fc269be1
commit
2fb69de493
29
p/C0CLA7Q.m
29
p/C0CLA7Q.m
|
|
@ -1,5 +1,5 @@
|
|||
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 12, 2009
|
||||
;;5.2;;****;Sep 27, 1994
|
||||
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 13, 2009
|
||||
;;n.n;;****;
|
||||
;
|
||||
;
|
||||
Q
|
||||
|
|
@ -11,13 +11,13 @@ LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for
|
|||
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)
|
||||
D GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(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
|
||||
I $D(^AUPNVLAB) D
|
||||
. D VCHECK
|
||||
. I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
|
||||
;
|
||||
;K ^TMP("C0C-VLAB",$J)
|
||||
;
|
||||
|
|
@ -83,7 +83,7 @@ LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a
|
|||
; If LOINC found then update variable with LN code
|
||||
I C0CLN'="" D
|
||||
. S X=$P(LA7X,"^",3)
|
||||
. S $P(X,"!",3)=C0CLN
|
||||
. I $P(X,"!",3)="" S $P(X,"!",3)=C0CLN
|
||||
. S $P(LA7X,"^",3)=X
|
||||
;
|
||||
Q
|
||||
|
|
@ -95,6 +95,7 @@ VCHK1 ; Check the entry in V Lab to determine if it meets criteria
|
|||
;
|
||||
F I=0,12 S C0CVLAB(I)=^AUPNVLAB(C0CDA,I)
|
||||
;
|
||||
; JMC 04/13/09 - Store anything for now that meets date criteria.
|
||||
D VSTORE
|
||||
;
|
||||
Q
|
||||
|
|
@ -102,5 +103,17 @@ VCHK1 ; Check the entry in V Lab to determine if it meets criteria
|
|||
;
|
||||
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))=""
|
||||
N PARENT
|
||||
;
|
||||
; Determine parent test to use for OBR segment
|
||||
S PARENT=$P(C0CVLAB(12),"^",8)
|
||||
I PARENT="" S PARENT=$P(C0CVLAB(0),"^")
|
||||
;
|
||||
; patient ien
|
||||
; | collection date/time
|
||||
; | | parent test (ordered test)
|
||||
; | | | ien of entry in V LAB file
|
||||
; | | | |
|
||||
S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),PARENT,C0CDA)=""
|
||||
;
|
||||
Q
|
||||
|
|
|
|||
44
p/LA7QRY2.m
44
p/LA7QRY2.m
|
|
@ -1,5 +1,5 @@
|
|||
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
|
||||
LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
|
||||
;;5.2;AUTOMATED LAB INSTRUMENTS;**46**;Sep 27, 1994
|
||||
; JMC - mods to check for IHS V LAB file
|
||||
;
|
||||
Q
|
||||
|
|
@ -9,15 +9,18 @@ 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
|
||||
; SSN passed as patient identifier
|
||||
I LA7PTID?9N.1A D
|
||||
. S LA7PTYP=1
|
||||
. S LA7X=$O(^DPT("SSN",LA7PTID,0))
|
||||
. I LA7X>0 D SETDFN(LA7X)
|
||||
;
|
||||
; 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
|
||||
I LA7PTID?10N1"V"6N D
|
||||
. S LA7PTYP=2
|
||||
. S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V"))
|
||||
. I LA7X>0 D SETDFN(LA7X)
|
||||
;
|
||||
; If no patient identified/no laboratory record - return exception message
|
||||
I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed"
|
||||
|
|
@ -35,8 +38,7 @@ BCD ; Search by specimen collection date.
|
|||
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
|
||||
F LRSS="CH","MI","SP" 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
|
||||
|
|
@ -67,13 +69,12 @@ BRAD ; Search by results available date (completion date).
|
|||
. . 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
|
||||
. . . S LRIDT=$QS(LA7ROOT,7)
|
||||
. . . F LRSS="CH","MI","SP" 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
|
||||
I 'LA7SRC D
|
||||
. F LRSS="CH","MI","SP" D
|
||||
. . S LRIDT=0
|
||||
. . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT D
|
||||
. . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
|
||||
|
|
@ -117,7 +118,7 @@ CHSS ; Search "CH" datanames for matching codes
|
|||
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.
|
||||
. I $D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.
|
||||
. S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761)
|
||||
. D CHECK
|
||||
;
|
||||
|
|
@ -181,14 +182,3 @@ 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
|
||||
|
|
|
|||
41
p/LA7VOBX1.m
41
p/LA7VOBX1.m
|
|
@ -1,33 +1,29 @@
|
|||
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
|
||||
LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/13/09
|
||||
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;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
|
||||
N LA76304,LA7ALT,LA7DIV,LA7I,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
|
||||
I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) 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),"^")
|
||||
;
|
||||
; Check for no LOINC in 63 and LOINC found in V LAB file.
|
||||
I $P(LA7X,"!",3)="",$D(^TMP("LA7-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) S $P(LA7X,"!",3)=$P(^TMP("LA7-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
|
||||
|
|
@ -70,10 +66,7 @@ CH ; Observation/Result segment for "CH" subscript results.
|
|||
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)
|
||||
S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
|
||||
;
|
||||
; Observation identifer
|
||||
; build alternate code based on dataname from file #63 in case it's needed
|
||||
|
|
@ -82,28 +75,20 @@ CH ; Observation/Result segment for "CH" subscript results.
|
|||
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)
|
||||
S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH)
|
||||
;
|
||||
; Units
|
||||
S LA7X=$P(LA7VAL,"^",5)
|
||||
; Units - remove leading and trailing spaces
|
||||
S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ")
|
||||
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))
|
||||
S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,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)
|
||||
S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F"))
|
||||
;
|
||||
; Observation date/time - collection date/time per HL7 standard
|
||||
I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue