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 ;DALOI/JMC,TMK - LAB DATA SERVER CONT'D SNOMED EXTRACT ; 17 Apr 2013 2:03 PM
  1. ;;5.2;LAB SERVICE;**346,378,350,425,460,495**;Sep 27, 1994;Build 6
  1. ;
  1. ; 5.2;LAB SERVICE; CHANGE FOR PATCH LR*5.2*495; Jul 10 2017
  1. ;
  1. ; Produces SNOMED extract via LRLABSERVER option
  1. ;
  1. ; **** NOTE: if record format is changed then update corresponding extract record building in LRERT ***
  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. ;
  1. N I,J,LRCNT,LRCRLF,LRETIME,LRFN,LRLEX,LRNAME,LRNODE,LRQUIT,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSPEC,LRSTIME,LRSTR,LRVAL,LRVUID,LRX,LRY,X,Y
  1. ;
  1. ;ZEXCEPT: LRST,LRSTN
  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"),LRCNT("SCT","EC"))=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),LRCNT(I,"SCT"),LRCNT(I,"SCT","EC"))=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. . I LRCNT(I,"SCT","EC") S ^TMP($J,"LRDATA",J)=^TMP($J,"LRDATA",J)_" ("_LRCNT(I,"SCT","EC")_" exceptions)"
  1. S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)_" ("_LRCNT("SCT")_" mapped)"
  1. I LRCNT("SCT","EC") S ^TMP($J,"LRDATA",J+1)=^TMP($J,"LRDATA",J+1)_" ("_LRCNT("SCT","EC")_" exceptions)"
  1. ;
  1. Q
  1. ;
  1. ;
  1. CLEAN ;
  1. ;
  1. ;ZEXCEPT: LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN
  1. ;
  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. N LRNAME,LRVFLD,X
  1. ;
  1. ;ZEXCEPT: LRCNT,LRFN,LRIEN,LRLEX,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSNM,LRSPEC,LRSPECN,LRST,LRSTR,LRVUID,LRX
  1. ;
  1. ;
  1. S LRVFLD(21)=$$VFIELD^DILFD(LRFN,21)
  1. F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D
  1. . S LRIEN=$QS(LRROOT,4),LRSPEC=""
  1. . S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^") ;,LRNAME=$$TRIM^XLFSTR(LRNAME,"RL"," ")
  1. . I $G(@LRROOT),LRNAME'=$QS(LRROOT,3) Q
  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. . . N LRLEXARR
  1. . . S LRLEXARR=$$CODE^LRSCT(LRSCT,"SCT",DT,"LRLEXARR")
  1. . . S LRSCTX=$G(LRLEXARR("F")),LRSCTEC=$S(LRLEXARR<1:$P(LRLEXARR,"^",2),1:"")
  1. . . I LRSCTVER="",LRLEXARR>0 S LRSCTVER=$P($G(LRLEXARR(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.2|"
  1. . I LRVFLD(21) S LRSTR=LRSTR_$$GET1^DIQ(LRFN,LRIEN_",",21,"I")
  1. . S LRSTR=LRSTR_"|"
  1. . ;START OF CHANGE FOR LR*5.2*495 to Send Inactive date for 61.2
  1. . ;I LRFN=61!(LRFN=62) D ; Inactive date
  1. . I LRFN=61!(LRFN=62)!(LRFN=61.2) D ; Inactive date
  1. .. I LRFN=61 S LRSTR=LRSTR_$TR($$FMTE^XLFDT($$GET1^DIQ(LRFN,LRIEN_",",64.9103,"I"),"1D")," ,","/")
  1. .. I LRFN=62 S LRSTR=LRSTR_$TR($$FMTE^XLFDT($$GET1^DIQ(LRFN,LRIEN_",",64.9101,"I"),"1D")," ,","/")
  1. .. I LRFN=61.2 S LRSTR=LRSTR_$TR($$FMTE^XLFDT($$GET1^DIQ(LRFN,LRIEN_",",64.9102,"I"),"1D")," ,","/")
  1. .. ;END OF CHANGE FOR LR*5.2*495
  1. .. S LRSTR=LRSTR_"|"
  1. . S LRCNT=LRCNT+1,LRCNT(LRFN)=LRCNT(LRFN)+1
  1. . I LRSCT D
  1. . . S LRCNT("SCT")=LRCNT("SCT")+1,LRCNT(LRFN,"SCT")=LRCNT(LRFN,"SCT")+1
  1. . . I LRSCTEC'="" S LRCNT("SCT","EC")=LRCNT("SCT","EC")+1,LRCNT(LRFN,"SCT","EC")=LRCNT(LRFN,"SCT","EC")+1
  1. . D SETDATA
  1. Q
  1. ;
  1. ;
  1. SETDATA ; Set data into report structure
  1. ;
  1. ;ZEXCEPT: LRCRLF,LRNODE,LRSTR
  1. ;
  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 I,LRFILENM,X
  1. ;
  1. ;ZEXCEPT: LRSCTVER,LRSTIME,LRSTN,LRSUB
  1. ;
  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......: "_LRSCTVER
  1. S ^TMP($J,"LRDATA",4)="Extract version........: "_$$VER()
  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|Term Status|Inactive Date|"
  1. S ^TMP($J,"LRDATA",20)=X
  1. S X=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 |"
  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. VER() ; Extract version
  1. Q "1.2"
  1. ;
  1. ;
  1. MAILSEND(LRMSUBJ) ; Send extract back to requestor.
  1. ;
  1. N LRINSTR,LRTASK,LRTO,XMERR,XMZ
  1. ;
  1. ;ZEXCEPT: XQSND
  1. ;
  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