Index: ccr/trunk/p/C0CLA7Q.m
===================================================================
--- ccr/trunk/p/C0CLA7Q.m	(revision 433)
+++ ccr/trunk/p/C0CLA7Q.m	(revision 434)
@@ -1,4 +1,4 @@
-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;;****;
 	;
 	;
@@ -12,11 +12,11 @@
 	;
 	; 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)
@@ -84,5 +84,5 @@
 	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
 	;
@@ -96,4 +96,5 @@
 	F I=0,12 S C0CVLAB(I)=^AUPNVLAB(C0CDA,I)
 	;
+	; JMC 04/13/09 - Store anything for now that meets date criteria.
 	D VSTORE
 	;
@@ -103,4 +104,16 @@
 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
Index: ccr/trunk/p/LA7QRY2.m
===================================================================
--- ccr/trunk/p/LA7QRY2.m	(revision 433)
+++ ccr/trunk/p/LA7QRY2.m	(revision 434)
@@ -1,4 +1,4 @@
-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
  ;
@@ -10,13 +10,16 @@
  ;
  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
@@ -36,6 +39,5 @@
  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)
@@ -68,11 +70,10 @@
  . . 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
@@ -118,5 +119,5 @@
  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
@@ -182,13 +183,2 @@
  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
Index: ccr/trunk/p/LA7VOBX1.m
===================================================================
--- ccr/trunk/p/LA7VOBX1.m	(revision 433)
+++ ccr/trunk/p/LA7VOBX1.m	(revision 434)
@@ -1,4 +1,4 @@
-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
  ;
@@ -6,5 +6,5 @@
  ; 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
@@ -13,20 +13,16 @@
  ; 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
@@ -71,8 +67,5 @@
  ;
  ; 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
@@ -83,14 +76,8 @@
  ;
  ; 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)
  ;
@@ -99,10 +86,8 @@
  ;
  ; 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
