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