source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSRVR6.m@ 1006

Last change on this file since 1006 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 4.3 KB
Line 
1LRSRVR6 ;DALIO/JMC - LAB DATA SERVER CONT'D SNOMED EXTRACT ;Aug 17, 2006
2 ;;5.2;LAB SERVICE;**346**;Sep 27, 1994;Build 10
3 ; Produces SNOMED extract via LRLABSERVER option
4 ;
5 Q
6 ;
7 ;
8SERVER ; Server entry Point
9 N I,LRCNT,LREND,LRL,LRMSUBJ,LRST,LRSTN,LRTXT,LRX,LRY
10 D BUILD
11 S LRMSUBJ=LRST_" "_LRSTN_" SNOMED EXTRACT "_$$HTE^XLFDT($H,"1M")
12 D MAILSEND(LRMSUBJ)
13 D CLEAN
14 Q
15 ;
16 ;
17BUILD ; Build extract
18 N J,LRCNT,LRCRLF,LRETIME,LRFN,LRLEX,LRNAME,LRQUIT,LRROOT,LRSCT,LRSCTEC,LRSCTVER,LRSCTX,LRSPEC,LRSTIME,LRSTR,LRVAL,LRVUID,LRX,LRY,X,Y
19 ;
20 S LRSTIME=$$NOW^XLFDT,LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2),LRSCTVER=""
21 I LRST="" S LRST="???"
22 K ^TMP($J,"LRDATA")
23 S (LRCNT,LRCNT("SCT"))=0,LRCRLF=$C(13,10),LRSTR=""
24 F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 S LRCNT(I)=0,LRCNT(I,"SCT")=0
25 D HDR
26 ;
27 ; Flag to indicate if SNOMED CT is available from LEXICON.
28 S LRLEX=0
29 I $T(CODE^LEXTRAN)'="" S LRLEX=1
30 ;
31 F LRFN=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D
32 . S LRROOT="^LAB("_LRFN_",""B"")"
33 . D FILE
34 ;
35 S LRETIME=$$NOW^XLFDT
36 ; Set the final info into the ^TMP message global
37 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
38 I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
39 S ^TMP($J,"LRDATA",LRNODE+1)=" "
40 S ^TMP($J,"LRDATA",LRNODE+2)="end"
41 ;
42 S ^TMP($J,"LRDATA",1)=^TMP($J,"LRDATA",1)_" (Run time:"_$$FMDIFF^XLFDT(LRETIME,LRSTIME,3)_")"
43 S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "_LRSCTVER
44 S J=6
45 S ^TMP($J,"LRDATA",J)="Number of records per file:"
46 F I=61,61.1,61.2,61.3,61.4,61.5,61.6,62 D
47 . S J=J+1
48 . S ^TMP($J,"LRDATA",J)=" "_$$LJ^XLFSTR($$GET1^DID(I,"","","NAME")_" File (#"_I_")",32,".")_": "_$J(LRCNT(I),5)_" ("_LRCNT(I,"SCT")_" mapped)"
49 S ^TMP($J,"LRDATA",J+1)=$$LJ^XLFSTR("Total number of records",33,".")_": "_$J(LRCNT,5)_" ("_LRCNT("SCT")_" mapped)"
50 ;
51 Q
52 ;
53 ;
54CLEAN ;
55 K ^TMP($J,"LR61")
56 K LRIEN,LRLEN,LRNODE,LRSNM,LRSPECN
57 D CLEAN^LRSRVR
58 D ^%ZISC
59 Q
60 ;
61 ;
62FILE ; Search file entry and build record.
63 ;
64 F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D
65 . Q:$G(@LRROOT)
66 . S LRIEN=$QS(LRROOT,4),LRSPEC=""
67 . S LRNAME=$P($G(^LAB(LRFN,LRIEN,0)),"^"),LRNAME=$$TRIM^XLFSTR(LRNAME,"RL"," ")
68 . S X=$P($G(^LAB(LRFN,LRIEN,0)),"^",2)
69 . S LRSNM=$S(LRFN'=62:X,1:"")
70 . I LRFN=62 S LRSPEC=X
71 . I LRSNM'="",LRFN>60.9,LRFN<61.61 S LRX=((LRFN*10)#610)+1,LRSNM=$E("TMEFDPJ",LRX)_"-"_LRSNM
72 . S LRSCT=$P($G(^LAB(LRFN,LRIEN,"SCT")),"^"),(LRSCTEC,LRSCTX,LRVUID)=""
73 . I LRLEX,LRSCT'="" D
74 . . K LRX
75 . . S LRX=$$CODE^LEXTRAN(LRSCT,"SCT",DT,"LRX")
76 . . S LRSCTX=$G(LRX("F")),LRSCTEC=$S(LRX<1:$P(LRX,"^",2),1:"")
77 . . I LRSCTVER="",LRX>0 S LRSCTVER=$P($G(LRX(0)),"^",3)
78 . S LRSTR=LRSTR_LRST_"-"_LRFN_"-"_LRIEN_"|"_LRNAME_"|"_LRSNM_"|"_LRVUID_"|"_LRSCT_"|"_LRSCTX_"|"_LRSCTEC_"|"
79 . S LRSPECN="|"
80 . I LRFN=62,LRSPEC D
81 . . S LRSPECN=$P($G(^LAB(61,LRSPEC,0)),"^")
82 . . S LRSPECN=LRSPECN_"|"_LRST_"-61-"_LRSPEC
83 . S LRSTR=LRSTR_LRSPECN_"|1.1|"
84 . S LRCNT=LRCNT+1,LRCNT(LRFN)=LRCNT(LRFN)+1 S:LRSCT LRCNT("SCT")=LRCNT("SCT")+1,LRCNT(LRFN,"SCT")=LRCNT(LRFN,"SCT")+1
85 . D SETDATA
86 Q
87 ;
88 ;
89SETDATA ; Set data into report structure
90 S LRSTR=LRSTR_LRCRLF
91 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
92 D ENCODE^LRSRVR4(.LRSTR)
93 Q
94 ;
95 ;
96HDR ; Set the header information
97 N LRFILENM
98 S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT(LRSTIME),"-")_".TXT"
99 S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT(LRSTIME)_" at "_LRSTN
100 S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
101 S ^TMP($J,"LRDATA",3)="SNOMED CT version......: "
102 S ^TMP($J,"LRDATA",4)="Extract version........: 1.1"
103 F I=5,15,16,18,23 S ^TMP($J,"LRDATA",I)=" "
104 S ^TMP($J,"LRDATA",17)="Attached file..........: "_LRFILENM
105 S ^TMP($J,"LRDATA",19)="Legend:"
106 S X="Station #-File #-IEN|Entry Name|SNOMED I|VUID|SNOMED CT|SNOMED CT TERM|Mapping Exception|Related Specimen|Related Specimen ID|Extract Ver|"
107 S ^TMP($J,"LRDATA",20)=X
108 S X=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |"
109 S ^TMP($J,"LRDATA",21)=X
110 S ^TMP($J,"LRDATA",22)=$$REPEAT^XLFSTR("-",$L(X))
111 S ^TMP($J,"LRDATA",24)=$$UUBEGFN^LRSRVR2A(LRFILENM)
112 Q
113 ;
114 ;
115MAILSEND(LRMSUBJ) ; Send extract back to requestor.
116 ;
117 N LRINSTR,LRTASK,LRTO,XMERR,XMZ
118 S LRTO(XQSND)=""
119 S LRINSTR("ADDR FLAGS")="R"
120 S LRINSTR("FROM")="LAB_PACKAGE"
121 D SENDMSG^XMXAPI(.5,LRMSUBJ,"^TMP($J,""LRDATA"")",.LRTO,.LRINSTR,.LRTASK)
122 Q
Note: See TracBrowser for help on using the repository browser.