Index: ccr/branches/ohum/p/C0CQRY1.m
===================================================================
--- ccr/branches/ohum/p/C0CQRY1.m	(revision 1333)
+++ ccr/branches/ohum/p/C0CQRY1.m	(revision 1337)
@@ -1,123 +1,123 @@
-LA7QRY1	;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
-	       ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 1
-	       ;
-	       Q
-	       ;
-CHKSC	  ; Check search NLT/LOINC codes
-	       ;
-	       N J
-	       ;
-	       S J=0
-	       F  S J=$O(LA7SC(J)) Q:'J  D
-	       . N X
-	       . S X=LA7SC(J)
-	       . I $P(X,"^",2)="NLT",$D(^LAM("E",$P(X,"^"))) D  Q
-	       . . S ^TMP("LA7-NLT",$J,$P(X,"^"))=""
-	       . I $P(X,"^",2)="LN",$D(^LAB(95.3,$P($P(X,"^"),"-"))) D  Q
-	       . . S ^TMP("LA7-LN",$J,$P($P(X,"^"),"-"))=""
-	       . S LA7ERR(6)="Unknown search code "_$P(X,"^")_" passed"
-	       . K LA7SC(J)
-	       Q
-	       ;
-	       ;
-SPEC	   ; Convert HL7 Specimen Codes to File #61, Topography codes
-	       ; Find all topographies that use this HL7 specimen code
-	       N J,K,L
-	       ;
-	       S J=0
-	       F  S J=$O(LA7SPEC(J)) Q:'J  D
-	       . S K=LA7SPEC(J),L=0
-	       . F  S L=$O(^LAB(61,"HL7",K,L)) Q:'L  S ^TMP("LA7-61",$J,L)=""
-	       Q
-	       ;
-	       ;
-BUILDMSG	       ; Build HL7 message with result of query
-	       ;
-	       N HL,HLECH,HLFS,HLQ,LA,LA763,LA7ECH,LA7FS,LA7MSH,LA7NOMSG,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7ROOT,LA7X,X
-	       ;
-	       I $L($G(LA7HL7))'=5 S LA7HL7="|^\~&"
-	       S (HL("FS"),HLFS,LA7FS)=$E(LA7HL7),(HL("ECH"),HLECH,LA7ECH)=$E(LA7HL7,2,5)
-	       S (HLQ,HL("Q"))=""""""
-	       ; Set flag to not send HL7 message
-	       S LA7NOMSG=1
-	       ; Create dummy MSH to pass HL7 delimiters
-	       S LA7MSH(0)="MSH"_LA7FS_LA7ECH_LA7FS
-	       D FILESEG^LA7VHLU(GBL,.LA7MSH)
-	       ;
-	       F X="AUTO-INST","LRDFN","LRIDT","SUB","HUID","NLT","RUID","SITE" S LA(X)=""
-	       ;
-	       ; Take search results and put in HL7 message structure
-	       S LA7ROOT="^TMP(""LA7-QRY"",$J)",(LA7QUIT,LA7PIDSN)=0
-	       ; F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7QUIT  D ;change per John M
-	       F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  D  Q:LA7QUIT
-	       . I $QS(LA7ROOT,1)'="LA7-QRY"!($QS(LA7ROOT,2)'=$J) S LA7QUIT=1 Q
-	       . I LA("LRDFN")'=$QS(LA7ROOT,3) D PID S LA7OBRSN=0
-	       . I LA("LRIDT")'=$QS(LA7ROOT,4) D ORC,OBR
-	       . I LA("SUB")'=$QS(LA7ROOT,5) D ORC,OBR
-	       . I LA("NLT")'=$P($QS(LA7ROOT,6),"!") D ORC,OBR
-	       . D OBX
-	       ;
-	       Q
-	       ;
-	       ;
-PID	    ; Build PID segment
-	       ;
-	       N LA7PID
-	       ;
-	       S (LA("LRDFN"),LRDFN)=$QS(LA7ROOT,3)
-	       S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
-	       D DEM^LRX
-	       D PID^LA7VPID(LA("LRDFN"),"",.LA7PID,.LA7PIDSN,.HL)
-	       D FILESEG^LA7VHLU(GBL,.LA7PID)
-	       S (LA("LRIDT"),LA("SUB"))=""
-	       Q
-	       ;
-	       ;
-ORC	    ; Build ORC segment
-	       ;
-	       N X
-	       ;
-	       S LA("LRIDT")=$QS(LA7ROOT,4),LA("SUB")=$QS(LA7ROOT,5)
-	       S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
-	       S X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"ORU"))
-	       S LA("HUID")=$P(X,"^"),LA("SITE")=$P(X,"^",2),LA("RUID")=$P(X,"^",4)
-	       I LA("HUID")="" S LA("HUID")=$P(LA763(0),"^",6)
-	       S LA7NVAF=$$NVAF^LA7VHLU2(0),LA7NTESN=0
-	       D ORC^LA7VORU
-	       S LA("NLT")=""
-	       ;
-	       Q
-	       ;
-	       ;
-OBR	    ; Build OBR segment
-	       ;
-	       N LA764,LA7NLT
-	       ;
-	       S (LA("NLT"),LA7NLT)=$P($QS(LA7ROOT,6),"!"),(LA764,LA("ORD"))=""
-	       I $L(LA7NLT) D
-	       . S LA764=+$O(^LAM("E",LA7NLT,0))
-	       . I LA764 S LA("ORD")=$$GET1^DIQ(64,LA764_",",.01)
-	       I LA("SUB")="CH" D
-	       . D OBR^LA7VORU
-	       . D NTE^LA7VORU
-	       . S LA7OBXSN=0
-	       ;
-	       Q
-	       ;
-	       ;
-OBX	    ; Build OBX segment
-	       ;
-	       N LA7DATA,LA7VT
-	       ;
-	       S LA7NTESN=0
-	       I LA("SUB")="MI" D MI^LA7VORU1 Q
-	       I "CYEMSP"[LA("SUB") D AP^LA7VORU2 Q
-	       ;
-	       S LA7VT=$QS(LA7ROOT,7)
-	       D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LA7VT,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH)
-	       I '$D(LA7DATA) Q
-	       D FILESEG^LA7VHLU(GBL,.LA7DATA)
-	       ; Send any test interpretation from file #60
-	       D INTRP^LA7VORUA
-	       ;
-	       Q
+LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
+        ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 31
+        ;
+        Q
+        ;
+CHKSC   ; Check search NLT/LOINC codes
+        ;
+        N J
+        ;
+        S J=0
+        F  S J=$O(LA7SC(J)) Q:'J  D
+        . N X
+        . S X=LA7SC(J)
+        . I $P(X,"^",2)="NLT",$D(^LAM("E",$P(X,"^"))) D  Q
+        . . S ^TMP("LA7-NLT",$J,$P(X,"^"))=""
+        . I $P(X,"^",2)="LN",$D(^LAB(95.3,$P($P(X,"^"),"-"))) D  Q
+        . . S ^TMP("LA7-LN",$J,$P($P(X,"^"),"-"))=""
+        . S LA7ERR(6)="Unknown search code "_$P(X,"^")_" passed"
+        . K LA7SC(J)
+        Q
+        ;
+        ;
+SPEC    ; Convert HL7 Specimen Codes to File #61, Topography codes
+        ; Find all topographies that use this HL7 specimen code
+        N J,K,L
+        ;
+        S J=0
+        F  S J=$O(LA7SPEC(J)) Q:'J  D
+        . S K=LA7SPEC(J),L=0
+        . F  S L=$O(^LAB(61,"HL7",K,L)) Q:'L  S ^TMP("LA7-61",$J,L)=""
+        Q
+        ;
+        ;
+BUILDMSG        ; Build HL7 message with result of query
+        ;
+        N HL,HLECH,HLFS,HLQ,LA,LA763,LA7ECH,LA7FS,LA7MSH,LA7NOMSG,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7ROOT,LA7X,X
+        ;
+        I $L($G(LA7HL7))'=5 S LA7HL7="|^\~&"
+        S (HL("FS"),HLFS,LA7FS)=$E(LA7HL7),(HL("ECH"),HLECH,LA7ECH)=$E(LA7HL7,2,5)
+        S (HLQ,HL("Q"))=""""""
+        ; Set flag to not send HL7 message
+        S LA7NOMSG=1
+        ; Create dummy MSH to pass HL7 delimiters
+        S LA7MSH(0)="MSH"_LA7FS_LA7ECH_LA7FS
+        D FILESEG^LA7VHLU(GBL,.LA7MSH)
+        ;
+        F X="AUTO-INST","LRDFN","LRIDT","SUB","HUID","NLT","RUID","SITE" S LA(X)=""
+        ;
+        ; Take search results and put in HL7 message structure
+        S LA7ROOT="^TMP(""LA7-QRY"",$J)",(LA7QUIT,LA7PIDSN)=0
+        ; F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7QUIT  D ;change per John M
+        F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  D  Q:LA7QUIT
+        . I $QS(LA7ROOT,1)'="LA7-QRY"!($QS(LA7ROOT,2)'=$J) S LA7QUIT=1 Q
+        . I LA("LRDFN")'=$QS(LA7ROOT,3) D PID S LA7OBRSN=0
+        . I LA("LRIDT")'=$QS(LA7ROOT,4) D ORC,OBR
+        . I LA("SUB")'=$QS(LA7ROOT,5) D ORC,OBR
+        . I LA("NLT")'=$P($QS(LA7ROOT,6),"!") D ORC,OBR
+        . D OBX
+        ;
+        Q
+        ;
+        ;
+PID     ; Build PID segment
+        ;
+        N LA7PID
+        ;
+        S (LA("LRDFN"),LRDFN)=$QS(LA7ROOT,3)
+        S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
+        D DEM^LRX
+        D PID^LA7VPID(LA("LRDFN"),"",.LA7PID,.LA7PIDSN,.HL)
+        D FILESEG^LA7VHLU(GBL,.LA7PID)
+        S (LA("LRIDT"),LA("SUB"))=""
+        Q
+        ;
+        ;
+ORC     ; Build ORC segment
+        ;
+        N X
+        ;
+        S LA("LRIDT")=$QS(LA7ROOT,4),LA("SUB")=$QS(LA7ROOT,5)
+        S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
+        S X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"ORU"))
+        S LA("HUID")=$P(X,"^"),LA("SITE")=$P(X,"^",2),LA("RUID")=$P(X,"^",4)
+        I LA("HUID")="" S LA("HUID")=$P(LA763(0),"^",6)
+        S LA7NVAF=$$NVAF^LA7VHLU2(0),LA7NTESN=0
+        D ORC^LA7VORU
+        S LA("NLT")=""
+        ;
+        Q
+        ;
+        ;
+OBR     ; Build OBR segment
+        ;
+        N LA764,LA7NLT
+        ;
+        S (LA("NLT"),LA7NLT)=$P($QS(LA7ROOT,6),"!"),(LA764,LA("ORD"))=""
+        I $L(LA7NLT) D
+        . S LA764=+$O(^LAM("E",LA7NLT,0))
+        . I LA764 S LA("ORD")=$$GET1^DIQ(64,LA764_",",.01)
+        I LA("SUB")="CH" D
+        . D OBR^LA7VORU
+        . D NTE^LA7VORU
+        . S LA7OBXSN=0
+        ;
+        Q
+        ;
+        ;
+OBX     ; Build OBX segment
+        ;
+        N LA7DATA,LA7VT
+        ;
+        S LA7NTESN=0
+        I LA("SUB")="MI" D MI^LA7VORU1 Q
+        I "CYEMSP"[LA("SUB") D AP^LA7VORU2 Q
+        ;
+        S LA7VT=$QS(LA7ROOT,7)
+        D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LA7VT,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH)
+        I '$D(LA7DATA) Q
+        D FILESEG^LA7VHLU(GBL,.LA7DATA)
+        ; Send any test interpretation from file #60
+        D INTRP^LA7VORUA
+        ;
+        Q
