Index: ccr/trunk/p/C0CLA7Q.m
===================================================================
--- ccr/trunk/p/C0CLA7Q.m	(revision 437)
+++ ccr/trunk/p/C0CLA7Q.m	(revision 438)
@@ -1,3 +1,3 @@
-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,30 +69,52 @@
 	; 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,2 +147,20 @@
 	;
 	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
Index: ccr/trunk/p/LA7VOBX1.m
===================================================================
--- ccr/trunk/p/LA7VOBX1.m	(revision 437)
+++ ccr/trunk/p/LA7VOBX1.m	(revision 438)
@@ -1,3 +1,3 @@
-LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/14/09
+LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;Sep 27, 1994
  ; JMC - mods to check for IHS V LAB file
@@ -19,12 +19,12 @@
  I LA7X]"","BO"'[LA7X 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),"^")
 	;
- 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
+	; If no result NLT or LOINC try to determine from file #60
+	S LA7X=$P(LA7VAL,"^",3)
+	; WV check for IHS - NLT/LN codes from V LAB file
+	I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q
+	;
+	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