source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSRVR3.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1LRSRVR3 ;DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ;Aug 17,2006
2 ;;5.2;LAB SERVICE;**303,346**;Sep 27, 1994;Build 10
3 ;
4 ;
5LOINCLD ; Build and send local delimited LOINC report
6 N I,LR6206,LR64,LINR,LRA,LRB,LRCNT,LRCRLF,LRMSUBJ,LRNODE,LRSTR,LRTXT,LRXREF,X,Y
7 ;
8 K ^TMP($J,"LRSERVER","LOINC"),^TMP($J,"LRDATA")
9 S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
10 S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
11 S ^TMP($J,"LRDATA",3)="LOINC version..........: "_$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
12 S ^TMP($J,"LRDATA",4)="File version...........: "_$G(^LAB(95.3,"VR"))
13 S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
14 S ^TMP($J,"LRDATA",5)="Attached file..........: "_LRFILENM
15 S ^TMP($J,"LRDATA",7)=" "
16 S ^TMP($J,"LRDATA",8)="Legend:"
17 S X="Station #-64 ien-61 ien-Time Aspect|NLT Code|NLT Name|Default LOINC Code|Default LOINC Name|Default Test|Time Aspect|Specimen|Data Location|Data Type|Input Transform|Units|Test Name|LOINC Code|LOINC Name"
18 S ^TMP($J,"LRDATA",9)=X
19 S Y="|Reference Low|Reference High|Therapeutic Low|Therapeutic High|Subscript|Lab Section|"
20 S ^TMP($J,"LRDATA",10)=Y
21 S ^TMP($J,"LRDATA",11)=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 "
22 S ^TMP($J,"LRDATA",12)="| 16 | 17 | 18 | 19 | 20 | 21 |"
23 S ^TMP($J,"LRDATA",13)=$$REPEAT^XLFSTR("-",$L(X))
24 S ^TMP($J,"LRDATA",14)=$$REPEAT^XLFSTR("-",$L(Y))
25 S ^TMP($J,"LRDATA",15)=" "
26 S ^TMP($J,"LRDATA",16)=$$UUBEGFN^LRSRVR2A(LRFILENM)
27 S LINR=1,LRCNT=0,LRSTR="",LRTXT=0,LRCRLF=$C(13,10)
28 ;
29 F LRXREF="AI","AH" D
30 . S LRA=""
31 . F S LRA=$O(^LAM(LRXREF,LRA)) Q:'LRA D
32 . . S LRB=""
33 . . F S LRB=$O(^LAM(LRXREF,LRA,LRB)) Q:LRB="" S ^TMP($J,"LRSERVER","LOINC",LRB)=""
34 ;
35 S LR64=""
36 F S LR64=$O(^TMP($J,"LRSERVER","LOINC",LR64)) Q:LR64="" D LOINCLA
37 ;
38 S LR6206=0,LRSS="MI"
39 F S LR6206=$O(^LAB(62.06,LR6206)) Q:'LR6206 D
40 . S LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
41 . S LRREC=$$MICRO(LR64)
42 . S LRINDX=LRST_"-"_LR64_"-"_"AB"_LR6206
43 . S LRSTR=LRSTR_LRINDX_"|"_LRREC_LRCRLF
44 . D SETDATA^LRSRVR2
45 . S LRCNT=LRCNT+1
46 ;
47 S ^TMP($J,"LRDATA",6)="Total number of records: "_LRCNT
48 I '$O(^TMP($J,"LRDATA",15)) S ^TMP($J,"LRDATA",12)="No LOINC codes mapped at "_LRSTN
49 ;
50 ; Set the final info into the ^TMP( message global
51 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)+1
52 I LRSTR'="" S ^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
53 S ^TMP($J,"LRDATA",LRNODE+1)=" "
54 S ^TMP($J,"LRDATA",LRNODE+2)="end"
55 ;
56 S LRMSUBJ=LRST_" "_LRSTN_" LOCAL REPORT DELIMIT "_$$HTE^XLFDT($H,"1M")
57 D MAILSEND^LRSRVR6(LRMSUBJ)
58 D CLEAN^LRSRVR
59 Q
60 ;
61 ;
62LOINCLA ;
63 N LR60,LR61,LRAA,LRAA1,LRERR,LRINDX,LOINCDTA,LOINCDTB,LRPNTA,LRPNTB,LRREC,LRSS,LRX
64 D GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
65 D GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
66 S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
67 ;
68 ; NLT Code/Procedure
69 S LRSTUB=$G(LOINCDTB(64,LRPNTB,1,"E"))
70 S $P(LRSTUB,"|",2)=$G(LOINCDTB(64,LRPNTB,.01,"I"))
71 ;
72 ; Default LOINC code/name
73 S $P(LRSTUB,"|",3)=$G(LOINCDTB(64,LRPNTB,25,"E"))
74 S $P(LRSTUB,"|",4)=$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"I")),81))
75 ;
76 ; Default LOINC code test (64,25.5)
77 S $P(LRSTUB,"|",5)=$G(LOINCDTB(64,LRPNTB,25.5,"I"))
78 ;
79 ; Look for 64.01 & 64.02 here
80 S LRAA1=""
81 F S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1="" D
82 . I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D Q
83 . . S $P(LRSTUB,"|",6)="Specimen sub-field error in file 64 - "_LRAA1
84 . . S $P(LRSTUB,"|",7)=$G(LRERR("DIERR",1,"TEXT",1))
85 . . S LRSTR=LRSTR_LRCRLF
86 . . D SETDATA^LRSRVR2
87 . . S LRCNT=LRCNT+1
88 . S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
89 . S $P(LRSTUB,"|",6)=$$GET1^DIQ(61,LRPNTA_",",.0961) ; Time Aspect
90 . S $P(LRSTUB,"|",7)=LOINCDTA(64.01,LRAA1,.01,"E") ; Specimen
91 . S LRAA=""
92 . F S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA="" I LRAA[LRAA1 D
93 . . S $P(LRSTUB,"|",8)=$G(LOINCDTA(64.02,LRAA,2,"E")) ; Data location
94 . . S LR60=+LOINCDTA(64.02,LRAA,3,"I")
95 . . S LR61=+LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
96 . . S $P(LRSTUB,"|",9,10)=$$TSTTYP(LOINCDTA(64.02,LRAA,2,"I"))
97 . . S LRSS=$$GET1^DIQ(60,LR60_",",4,"I") ; Subscript
98 . . S LRX=$$GET1^DIQ(60.01,LR61_","_LR60_",",6) ; Units
99 . . S $P(LRSTUB,"|",11)=$$TRIM^XLFSTR(LRX,"LR"," ")
100 . . S $P(LRSTUB,"|",12)=LOINCDTA(64.02,LRAA,3,"E") ; Test name
101 . . S $P(LRSTUB,"|",13)=$G(LOINCDTA(64.02,LRAA,4,"E")) ; Loinc code
102 . . S $P(LRSTUB,"|",14)=$G(^LAB(95.3,+$G(LOINCDTA(64.02,LRAA,4,"E")),81)) ; LOINC code (64.02,4)
103 . . S X=$G(^LAB(60,LR60,1,LR61,0))
104 . . S $P(LRSTUB,"|",15)=$P(X,"^",2) ; Test reference low
105 . . S $P(LRSTUB,"|",16)=$P(X,"^",3) ; Test reference high
106 . . S $P(LRSTUB,"|",17)=$P(X,"^",11) ; Test therapeutic low
107 . . S $P(LRSTUB,"|",18)=$P(X,"^",12) ; Test therapeutic high
108 . . S $P(LRSTUB,"|",19)=LRSS ; Lab subscript
109 . . S $P(LRSTUB,"|",20)=$G(LOINCDTB(64,LRPNTB,13,"E")) ; Lab section
110 . . S LRINDX=LRST_"-"_LR64_"-"_LR61_"-"_LOINCDTA(64.02,LRAA,.01,"I")
111 . . S LRSTR=LRSTR_LRINDX_"|"_LRSTUB_LRCRLF
112 . . D SETDATA^LRSRVR2
113 . . S LRCNT=LRCNT+1
114 Q
115 ;
116 ;
117MICRO(LR64) ;
118 N LOINCDTB,LR6421,LRPNTB,LRSTUB
119 S LRSTUB=""
120 D GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
121 D GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
122 S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB="" LRSTUB
123 ;
124 ; NLT Code/Procedure
125 S LRSTUB=$G(LOINCDTB(64,LRPNTB,1,"E"))
126 S $P(LRSTUB,"|",2)=$G(LOINCDTB(64,LRPNTB,.01,"I"))
127 ;
128 ; Default LOINC code/name
129 S $P(LRSTUB,"|",3)=$G(LOINCDTB(64,LRPNTB,25,"E"))
130 S $P(LRSTUB,"|",4)=$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"I")),81))
131 ;
132 ; Anti-microbial Suscept (62.06,.01)
133 S $P(LRSTUB,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
134 ;
135 ; Lab subscript/section
136 S $P(LRSTUB,"|",19)=LRSS
137 I $G(LOINCDTB(64,LRPNTB,13,"I")) D ; Lab section
138 . S LR6421=LOINCDTB(64,LRPNTB,13,"I")
139 . S $P(LRSTUB,"|",20)=$$GET1^DIQ(64.21,LR6421_",",1)
140 ;
141 Q LRSTUB
142 ;
143 ;
144TSTTYP(LRX) ; Determine test data type
145 N LRSTUB,LRTYPE,LRY
146 I LRX="" Q "|"
147 S LRX=$P(LRX,"(",2)
148 ;
149 ; Data type
150 S LRTYPE=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","TYPE")
151 S $P(LRSTUB,"|",2)=LRTYPE
152 ;
153 ; Input transform
154 S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"",$S(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
155 I LRTYPE="NUMERIC",LRY["LRNUM" D
156 . S LRX=$P(LRY,"""",2)
157 . I LRX?.1"-".N1","1.N1","1N S LRY="Number from "_$P(LRX,",")_" to "_$P(LRX,",",2)_" with "_$P(LRX,",",3)_" decimal"
158 S $P(LRSTUB,"|",1)=LRY
159 ; Help prompt
160 I LRTYPE="FREE TEXT" D
161 . S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","HELP-PROMPT")
162 . S $P(LRSTUB,"|",1)=LRY
163 Q LRSTUB
Note: See TracBrowser for help on using the repository browser.