Changeset 438 for ccr/trunk/p/C0CLA7Q.m

Timestamp:

Apr 28, 2009, 10:37:09 PM (15 years ago)

Author:

George Lilly

Message:

changes to lab extract

File:

• ccr/trunk/p/C0CLA7Q.m (modified) (3 diffs)

ccr/trunk/p/C0CLA7Q.m

@@ -1 @@
-C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 13, 2009
+C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 21, 2009
         ;;n.n;;****;
         ;
@@ -69 +69 @@
         ; Call from LA7QRY2
         ;
-        N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CTEST,X
+        N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,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)
+        S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5)
+        S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)=""
         ;
         ; ^AUPNVLAB("ALR1",5380,3080307.211055,"EKT 0307 48",188,5427202)=""
         ;
-        S C0C60=0,C0CLN=""
+        S C0C60=""
         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))
+        . D FINDDT
         . I C0CDA<1 Q
         . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
         . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8)
         . I C0CPDA="" S C0CPDA=C0CDA
-        . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^")
-        . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^")
+        . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2)
+        . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2)
+        . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^")
+        . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2)
         . S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
         . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)=""
-        . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST
+        . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST
+        ;
+        S X=$P(LA7X,"^",3)
+        ; If order NLT then update if no order NLT
+        I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64)
+        ;
+        ; If result NLT then update if no result NLT
+        I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64)
         ;
         ; If LOINC found then update variable with LN code
-        I C0CLN'="" D
-        . S X=$P(LA7X,"^",3)
-        . I $P(X,"!",3)="" S $P(X,"!",3)=C0CLN
-        . S $P(LA7X,"^",3)=X
+        I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN
+        ;
+        S $P(LA7X,"^",3)=X
+        ;
+        Q
+        ;
+        ;
+TMPCHK  ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments
+        ; Called from LA7VOBX1
+        ;
+        N I,X
+        ;
+        S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB))
+        I X="" Q
+        F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I)
+        S $P(LA7VAL,"^",3)=LA7X
         ;
         Q
@@ -125 +147 @@
         ;
         Q
+        ;
+        ;
+FINDDT  ; Find entry in V LAB for the date/time or one close to it.
+        ; RPMS stores related specimen entries under the same date/time.
+        ; Lab file #63 creates unique entries with slightly different times.
+        ;
+        S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0))
+        I C0CDA>0 Q
+        ;
+        ; If entry found then confirm that specimen type matches.
+        N C0CDTY
+        S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0))
+        I C0CDTY D
+        . I $P(C0CDT,".")'=$P(C0CDTY,".") Q
+        . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0))
+        . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA=""
+        ;
+        Q