source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m@ 1688

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