Index: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m
===================================================================
--- WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m	(revision 613)
+++ WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m	(revision 623)
@@ -1,123 +1,122 @@
-LRSRVR6	;DALIO/JMC - LAB DATA SERVER CONT'D SNOMED EXTRACT ;Aug 17, 2006
-	;;5.2;LAB SERVICE;**346,378**;Sep 27, 1994;Build 1
-	; Produces SNOMED extract via LRLABSERVER option
-	;
-	Q
-	;
-	;
-SERVER	; Server entry Point
-	N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY
-	D BUILD
-	S LRMSUBJ=LRST_" "_LRSTN_" SNOMED EXTRACT "_$$HTE^XLFDT($H,"1M")
-	D MAILSEND(LRMSUBJ)
-	D CLEAN
-	Q
-	;
-	;
-BUILD	; Build extract
-	N J,LRCNT,LRCRLF,LRETIME,LRFN,LRLEX,LRNAME,LRQUIT,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSPEC,LRSTIME,LRSTR,LRVAL,LRVUID,LRX,LRY,X,Y
-	;
-	S LRSTIME=$$NOW^XLFDT,LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2),LRSCTVER=""
-	I LRST="" S LRST="???"
-	K ^TMP($J,"LRDATA")
-	S (LRCNT,LRCNT("SCT"))=0,LRCRLF=$C(13,10),LRSTR=""
-	F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 S LRCNT(I)=0,LRCNT(I,"SCT")=0
-	D HDR
-	;
-	; Flag to indicate if SNOMED CT is available from LEXICON.
-	S LRLEX=0
-	I $T(CODE^LEXTRAN)'="" S LRLEX=1
-	;
-	F LRFN=61,61.1,61.2,61.3,61.4,61.5,61.6,62  D
-	. S LRROOT="^LAB("_LRFN_",""B"")"
-	. D FILE
-	;
-	S LRETIME=$$NOW^XLFDT
-	; Set the final info into the ^TMP message global
-	S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
-	I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
-	S ^TMP($J,"LRDATA",LRNODE+1)=" "
-	S ^TMP($J,"LRDATA",LRNODE+2)="end"
-	;
-	S ^TMP($J,"LRDATA",1)=^TMP($J,"LRDATA",1)_" (Run time:"_$$FMDIFF^XLFDT(LRETIME,LRSTIME,3)_")"
-	S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "_LRSCTVER
-	S J=6
-	S ^TMP($J,"LRDATA",J)="Number of records per file:"
-	F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D
-	. S J=J+1
-	. S ^TMP($J,"LRDATA",J)=" "_$$LJ^XLFSTR($$GET1^DID(I,"","","NAME")_" File (#"_I_")",32,".")_": "_$J(LRCNT(I),5)_"  ("_LRCNT(I,"SCT")_" mapped)"
-	S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)_"  ("_LRCNT("SCT")_" mapped)"
-	;
-	Q
-	;
-	;
-CLEAN	;
-	K ^TMP($J,"LR61")
-	K LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN
-	D CLEAN^LRSRVR
-	D ^%ZISC
-	Q
-	;
-	;
-FILE	; Search file entry and build record.
-	;
-	F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  Q:$QS(LRROOT,2)'="B"  D
-	. Q:$G(@LRROOT)
-	. S LRIEN=$QS(LRROOT,4),LRSPEC=""
-	. S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^"),LRNAME=$$TRIM^XLFSTR(LRNAME,"RL"," ")
-	. S X=$P($G(^LAB(LRFN,LRIEN,0)),"^",2)
-	. S LRSNM=$S(LRFN'=62:X,1:"")
-	. I LRFN=62 S LRSPEC=X
-	. I LRSNM'="",LRFN>60.9,LRFN<61.61 S LRX=((LRFN*10)#610)+1,LRSNM=$E("TMEFDPJ",LRX)_"-"_LRSNM
-	. S LRSCT=$P($G(^LAB(LRFN,LRIEN,"SCT")),"^"),(LRSCTEC,LRSCTX,LRVUID)=""
-	. I LRLEX,LRSCT'="" D
-	. . K LRX
-	. . S LRX=$$CODE^LEXTRAN(LRSCT,"SCT",DT,"LRX")
-	. . S LRSCTX=$G(LRX("F")),LRSCTEC=$S(LRX<1:$P(LRX,"^",2),1:"")
-	. . I LRSCTVER="",LRX>0 S LRSCTVER=$P($G(LRX(0)),"^",3)
-	. S LRSTR=LRSTR_LRST_"-"_LRFN_"-"_LRIEN_"|"_LRNAME_"|"_LRSNM_"|"_LRVUID_"|"_LRSCT_"|"_LRSCTX_"|"_LRSCTEC_"|"
-	. S LRSPECN="|"
-	. I LRFN=62,LRSPEC D
-	. . S LRSPECN=$P($G(^LAB(61,LRSPEC,0)),"^")
-	. . S LRSPECN=LRSPECN_"|"_LRST_"-61-"_LRSPEC
-	. S LRSTR=LRSTR_LRSPECN_"|1.1|"
-	. S LRCNT=LRCNT+1,LRCNT(LRFN)=LRCNT(LRFN)+1 S:LRSCT LRCNT("SCT")=LRCNT("SCT")+1,LRCNT(LRFN,"SCT")=LRCNT(LRFN,"SCT")+1
-	. D SETDATA
-	Q
-	;
-	;
-SETDATA	; Set data into report structure
-	S LRSTR=LRSTR_LRCRLF
-	S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
-	D ENCODE^LRSRVR4(.LRSTR)
-	Q
-	;
-	;
-HDR	; Set the header information
-	N LRFILENM
-	S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT(LRSTIME),"-")_".TXT"
-	S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT(LRSTIME)_" at "_LRSTN
-	S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
-	S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "
-	S ^TMP($J,"LRDATA",4)="Extract version........: 1.1"
-	F I=5,15,16,18,23 S ^TMP($J,"LRDATA",I)=" "
-	S ^TMP($J,"LRDATA",17)="Attached file..........: "_LRFILENM
-	S ^TMP($J,"LRDATA",19)="Legend:"
-	S X="Station #-File #-IEN|Entry Name|SNOMED I|VUID|SNOMED CT|SNOMED CT TERM|Mapping Exception|Related Specimen|Related Specimen ID|Extract Ver|"
-	S ^TMP($J,"LRDATA",20)=X
-	S X="           1        |     2    |   3    |  4 |    5    |       6      |        7        |        8       |        9          |    10     |"
-	S ^TMP($J,"LRDATA",21)=X
-	S ^TMP($J,"LRDATA",22)=$$REPEAT^XLFSTR("-",$L(X))
-	S ^TMP($J,"LRDATA",24)=$$UUBEGFN^LRSRVR2A(LRFILENM)
-	Q
-	;
-	;
-MAILSEND(LRMSUBJ)	; Send extract back to requestor.
-	;
-	N LRINSTR,LRTASK,LRTO,XMERR,XMZ
-	S LRTO(XQSND)=""
-	S LRINSTR("ADDR FLAGS")="R"
-	S LRINSTR("FROM")="LAB_PACKAGE"
-	S LRMSUBJ=$E(LRMSUBJ,1,65)
-	D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK)
-	Q
+LRSRVR6 ;DALIO/JMC - LAB DATA SERVER CONT'D SNOMED EXTRACT ;Aug 17, 2006
+ ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10
+ ; Produces SNOMED extract via LRLABSERVER option
+ ;
+ Q
+ ;
+ ;
+SERVER ; Server entry Point
+ N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY
+ D BUILD
+ S LRMSUBJ=LRST_" "_LRSTN_" SNOMED EXTRACT "_$$HTE^XLFDT($H,"1M")
+ D MAILSEND(LRMSUBJ)
+ D CLEAN
+ Q
+ ;
+ ;
+BUILD ; Build extract
+ N J,LRCNT,LRCRLF,LRETIME,LRFN,LRLEX,LRNAME,LRQUIT,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSPEC,LRSTIME,LRSTR,LRVAL,LRVUID,LRX,LRY,X,Y
+ ;
+ S LRSTIME=$$NOW^XLFDT,LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2),LRSCTVER=""
+ I LRST="" S LRST="???"
+ K ^TMP($J,"LRDATA")
+ S (LRCNT,LRCNT("SCT"))=0,LRCRLF=$C(13,10),LRSTR=""
+ F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 S LRCNT(I)=0,LRCNT(I,"SCT")=0
+ D HDR
+ ;
+ ; Flag to indicate if SNOMED CT is available from LEXICON.
+ S LRLEX=0
+ I $T(CODE^LEXTRAN)'="" S LRLEX=1
+ ;
+ F LRFN=61,61.1,61.2,61.3,61.4,61.5,61.6,62  D
+ . S LRROOT="^LAB("_LRFN_",""B"")"
+ . D FILE
+ ;
+ S LRETIME=$$NOW^XLFDT
+ ; Set the final info into the ^TMP message global
+ S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
+ I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
+ S ^TMP($J,"LRDATA",LRNODE+1)=" "
+ S ^TMP($J,"LRDATA",LRNODE+2)="end"
+ ;
+ S ^TMP($J,"LRDATA",1)=^TMP($J,"LRDATA",1)_" (Run time:"_$$FMDIFF^XLFDT(LRETIME,LRSTIME,3)_")"
+ S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "_LRSCTVER
+ S J=6
+ S ^TMP($J,"LRDATA",J)="Number of records per file:"
+ F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D
+ . S J=J+1
+ . S ^TMP($J,"LRDATA",J)=" "_$$LJ^XLFSTR($$GET1^DID(I,"","","NAME")_" File (#"_I_")",32,".")_": "_$J(LRCNT(I),5)_"  ("_LRCNT(I,"SCT")_" mapped)"
+ S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)_"  ("_LRCNT("SCT")_" mapped)"
+ ;
+ Q
+ ;
+ ;
+CLEAN ;
+ K ^TMP($J,"LR61")
+ K LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN
+ D CLEAN^LRSRVR
+ D ^%ZISC
+ Q
+ ;
+ ;
+FILE ; Search file entry and build record.
+ ;
+ F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  Q:$QS(LRROOT,2)'="B"  D
+ . Q:$G(@LRROOT)
+ . S LRIEN=$QS(LRROOT,4),LRSPEC=""
+ . S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^"),LRNAME=$$TRIM^XLFSTR(LRNAME,"RL"," ")
+ . S X=$P($G(^LAB(LRFN,LRIEN,0)),"^",2)
+ . S LRSNM=$S(LRFN'=62:X,1:"")
+ . I LRFN=62 S LRSPEC=X
+ . I LRSNM'="",LRFN>60.9,LRFN<61.61 S LRX=((LRFN*10)#610)+1,LRSNM=$E("TMEFDPJ",LRX)_"-"_LRSNM
+ . S LRSCT=$P($G(^LAB(LRFN,LRIEN,"SCT")),"^"),(LRSCTEC,LRSCTX,LRVUID)=""
+ . I LRLEX,LRSCT'="" D
+ . . K LRX
+ . . S LRX=$$CODE^LEXTRAN(LRSCT,"SCT",DT,"LRX")
+ . . S LRSCTX=$G(LRX("F")),LRSCTEC=$S(LRX<1:$P(LRX,"^",2),1:"")
+ . . I LRSCTVER="",LRX>0 S LRSCTVER=$P($G(LRX(0)),"^",3)
+ . S LRSTR=LRSTR_LRST_"-"_LRFN_"-"_LRIEN_"|"_LRNAME_"|"_LRSNM_"|"_LRVUID_"|"_LRSCT_"|"_LRSCTX_"|"_LRSCTEC_"|"
+ . S LRSPECN="|"
+ . I LRFN=62,LRSPEC D
+ . . S LRSPECN=$P($G(^LAB(61,LRSPEC,0)),"^")
+ . . S LRSPECN=LRSPECN_"|"_LRST_"-61-"_LRSPEC
+ . S LRSTR=LRSTR_LRSPECN_"|1.1|"
+ . S LRCNT=LRCNT+1,LRCNT(LRFN)=LRCNT(LRFN)+1 S:LRSCT LRCNT("SCT")=LRCNT("SCT")+1,LRCNT(LRFN,"SCT")=LRCNT(LRFN,"SCT")+1
+ . D SETDATA
+ Q
+ ;
+ ;
+SETDATA ; Set data into report structure
+ S LRSTR=LRSTR_LRCRLF
+ S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
+ D ENCODE^LRSRVR4(.LRSTR)
+ Q
+ ;
+ ;
+HDR ; Set the header information
+ N LRFILENM
+ S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT(LRSTIME),"-")_".TXT"
+ S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT(LRSTIME)_" at "_LRSTN
+ S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
+ S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "
+ S ^TMP($J,"LRDATA",4)="Extract version........: 1.1"
+ F I=5,15,16,18,23 S ^TMP($J,"LRDATA",I)=" "
+ S ^TMP($J,"LRDATA",17)="Attached file..........: "_LRFILENM
+ S ^TMP($J,"LRDATA",19)="Legend:"
+ S X="Station #-File #-IEN|Entry Name|SNOMED I|VUID|SNOMED CT|SNOMED CT TERM|Mapping Exception|Related Specimen|Related Specimen ID|Extract Ver|"
+ S ^TMP($J,"LRDATA",20)=X
+ S X="           1        |     2    |   3    |  4 |    5    |       6      |        7        |        8       |        9          |    10     |"
+ S ^TMP($J,"LRDATA",21)=X
+ S ^TMP($J,"LRDATA",22)=$$REPEAT^XLFSTR("-",$L(X))
+ S ^TMP($J,"LRDATA",24)=$$UUBEGFN^LRSRVR2A(LRFILENM)
+ Q
+ ;
+ ;
+MAILSEND(LRMSUBJ) ; Send extract back to requestor.
+ ;
+ N LRINSTR,LRTASK,LRTO,XMERR,XMZ
+ S LRTO(XQSND)=""
+ S LRINSTR("ADDR FLAGS")="R"
+ S LRINSTR("FROM")="LAB_PACKAGE"
+ D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK)
+ Q
