Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRSRVR6

LRSRVR6.m

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