source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSRVR1.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.1 KB
Line 
1LRSRVR1 ;DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ; March 25, 2002
2 ;;5.2;LAB SERVICE;**303**;Sep 27, 1994
3 ;
4 ;
5LOINC ; Scan for LOINC Coding
6 ;
7 N LR60,LR61,LRLLINA,LRLLINB,LRLLINC,LRX
8 K XMY
9 ;S XMY("G.LOINCSERVER@ISC-DALLAS.VA.GOV")=""
10 S XMY(XQSND)=""
11 S ^TMP($J,"LRDATA",1)="*"_$$NOW^XLFDT
12 S ^TMP($J,"LRDATA",2)="No codes defined at "_LRSTN
13 K ^TMP($J,"LRSERVER","LOINC")
14 S LINE=2,LINR=1
15 F LRSUB="AI","AH" D
16 . S LRA=""
17 . F S LRA=$O(^LAM(LRSUB,LRA)) Q:'LRA D
18 . . S LRB=""
19 . . F S LRB=$O(^LAM(LRSUB,LRA,LRB)) Q:LRB="" S ^TMP($J,"LRSERVER","LOINC",LRB)=""
20 ;
21 S LRA=""
22 F S LRA=$O(^TMP($J,"LRSERVER","LOINC",LRA)) Q:LRA="" D
23 . K LOINCDTA,LOINCDTB,LRERR
24 . D GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
25 . D GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
26 . S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
27 . I LINE>2 F Q:'$D(^TMP($J,"LRDATA",LINE)) S LINE=LINE+1
28 . S LRLLINA="~"_LRST_"^"_$G(LOINCDTB(64,LRPNTB,.01,"E"))
29 . ;PROCEDURE (64,.01)
30 . S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,1,"E"))
31 . ;WKLD CODE (64,1)
32 . S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,25,"E"))
33 . ;DEFAULT LOINC CODE (64,25)
34 . S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,25.5,"E"))
35 . ;LOOK FOR 64.01 & 64.02 HERE
36 . I '$O(LOINCDTA(64.01,"")) S ^TMP($J,"LRDATA",LINE)=LRLLINA S LINE=LINE+1
37 . S LRAA1=""
38 . F S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1="" D
39 . . I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D Q
40 . . . S ^TMP($J,"LRDTERR",LINR)="Specimen sub-field error in file 64!! "_LRAA1,LINR=LINR+1
41 . . . S ^TMP($J,"LRDTERR",LINR)=$G(LRERR("DIERR",1,"TEXT",1)),LINR=LINR+1
42 . . S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
43 . . D GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
44 . . S LRLLINB="^"_$G(LOINCTAS(61,LRPNTA_",",.0961))
45 . . ;TIME ASPECT (61,.0961)
46 . . S LRLLINB=LRLLINB_"^"_LOINCDTA(64.01,LRAA1,.01,"E")
47 . . ;SPECIMEN (64.01,.01)
48 . . I '$O(LOINCDTA(64.02,"")) S ^TMP($J,"LRDATA",LINE)=LRLLINA_LRLLINB,LINE=LINE+1
49 . . S LRAA=""
50 . . F S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA="" D
51 . . . S LRLLINC="^"_$G(LOINCDTA(64.02,LRAA,2,"E"))
52 . . . ;DATA LOCATION (64.02,2)
53 . . . D TSTNAM
54 . . . ;TEST (64.02,3)
55 . . . S LRLLINC=LRLLINC_"^"_$G(LOINCDTA(64.02,LRAA,4,"E"))
56 . . . S ^TMP($J,"LRDATA",LINE)=LRLLINA_LRLLINB_LRLLINC
57 . . . D TSTTYP,TSTUNS
58 . . . S LINE=LINE+1
59 D EXIT^LRSRVR
60 Q
61 ;
62 ;
63LOINCL ; Build and send local LOINC report
64 ;
65 N LINE,LINR,LRA,LRXREF
66 K ^TMP($J,"LRSERVER","LOINC")
67 K XMY
68 S XMY(XQSND)=""
69 S ^TMP($J,"LRDATA",1)="Report Generated "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
70 S ^TMP($J,"LRDATA",2)="No codes defined at "_LRSTN
71 S LINE=2,LINR=1
72 F LRXREF="AI","AH" D
73 . S LRA=""
74 . F S LRA=$O(^LAM(LRXREF,LRA)) Q:'LRA D
75 . . S LRB=""
76 . . F S LRB=$O(^LAM(LRXREF,LRA,LRB)) Q:LRB="" S ^TMP($J,"LRSERVER","LOINC",LRB)=""
77 ;
78 S LRA=""
79 F S LRA=$O(^TMP($J,"LRSERVER","LOINC",LRA)) Q:LRA="" D LOINCLA
80 D EXIT^LRSRVR
81 Q
82 ;
83 ;
84LOINCLA ;
85 N LR60,LR61,LRERR,LOINCDTA,LOINCDTB,LRPNTB,LRX
86 S:'$D(LINE) LINE=1 S:'$D(LINR) LINR=1
87 D GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
88 D GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
89 S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
90 S ^TMP($J,"LRDATA",LINE)="",LINE=LINE+1
91 S ^TMP($J,"LRDATA",LINE)="NLT Procedure: "_$G(LOINCDTB(64,LRPNTB,.01,"E")),LINE=LINE+1
92 ;
93 ; Procedure (64,.01)
94 S ^TMP($J,"LRDATA",LINE)="NLT Code: "_$G(LOINCDTB(64,LRPNTB,1,"E")),LINE=LINE+1
95 ;
96 ; WKLD CODE (64,1)
97 S ^TMP($J,"LRDATA",LINE)="Default LOINC Code: "_$G(LOINCDTB(64,LRPNTB,25,"E"))_" : "_$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"E")),80)),LINE=LINE+1
98 ;
99 ; Default LOINC code (64,25)
100 S ^TMP($J,"LRDATA",LINE)="Default LOINC Code Test: "_$G(LOINCDTB(64,LRPNTB,25.5,"E")),LINE=LINE+1
101 ;
102 ; Look for 64.01 & 64.02 here
103 S LRAA1=""
104 F S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1="" D
105 . I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D Q
106 . . S ^TMP($J,"LRDATA",LINE)="Specimen sub-field error in file 64!! "_LRAA1,LINE=LINE+1
107 . . S ^TMP($J,"LRDATA",LINE)=$G(LRERR("DIERR",1,"TEXT",1)),LINE=LINE+1
108 . S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
109 . D GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
110 . S ^TMP($J,"LRDATA",LINE)="Time Aspect: "_LOINCTAS(61,LRPNTA_",",.0961),LINE=LINE+1
111 . ; TIME ASPECT (61,.0961)
112 . S ^TMP($J,"LRDATA",LINE)="Specimen: "_LOINCDTA(64.01,LRAA1,.01,"E"),LINE=LINE+1
113 . ; SPECIMEN (64.01,.01)
114 . S LRAA=""
115 . F S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA="" I LRAA[LRAA1 D
116 . . S ^TMP($J,"LRDATA",LINE)="Data Location: "_$G(LOINCDTA(64.02,LRAA,2,"E")),LINE=LINE+1
117 . . ; DATA LOCATION (64.02,2)
118 . . D TSTTYP,TSTNAM,TSTUNS
119 . . S ^TMP($J,"LRDATA",LINE)="LOINC Code: "_$G(LOINCDTA(64.02,LRAA,4,"E"))_" : "_$G(^LAB(95.3,+$G(LOINCDTA(64.02,LRAA,4,"E")),80)),LINE=LINE+1
120 . . ; LOINC CODE (64.02,4)
121 Q
122 ;
123 ;
124TSTTYP ; Determine test data type
125 N LRX,LRTYPE,LRY
126 I LOINCDTA(64.02,LRAA,2,"I")="" Q
127 S LRX=$P(LOINCDTA(64.02,LRAA,2,"I"),"(",2)
128 S LRTYPE=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","TYPE")
129 I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",11)=LRTYPE
130 I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Type: "_LRTYPE,LINE=LINE+1
131 S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"",$S(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
132 I LRSUB="LOINC" S LRY=$TR(LRY,"^","~"),$P(^TMP($J,"LRDATA",LINE),"^",12)=LRY
133 I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Values: "_LRY,LINE=LINE+1
134 S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","HELP-PROMPT")
135 I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",13)=LRY
136 I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Help: "_LRY,LINE=LINE+1
137 Q
138 ;
139 ;
140TSTNAM ; Test name and units
141 N LRX,LRY
142 S LRX=LOINCDTA(64.02,LRAA,3,"E")
143 S LRY=""
144 I LOINCDTA(64.02,LRAA,3,"I") S LRY=LOINCDTA(64.02,LRAA,3,"I")_"-"_LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
145 I LRSUB="LOCAL REPORT" D
146 . S ^TMP($J,"LRDATA",LINE)="Test: "_LRX,LINE=LINE+1
147 . I LRY'="" S ^TMP($J,"LRDATA",LINE)="Test-Spec: "_LRY,LINE=LINE+1
148 I LRSUB="LOINC" D
149 . S LRLLINC=LRLLINC_"^"_LRX
150 . S $P(^TMP($J,"LRDATA",LINE),"^",15)=LRY
151 Q
152 ;
153 ;
154TSTUNS ; Test units
155 N LR60,LR61,LRY
156 S LR60=+LOINCDTA(64.02,LRAA,3,"I"),LR61=+LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
157 S LRY=$$GET1^DIQ(60.01,LR61_","_LR60_",",6)
158 I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",14)=LRY
159 I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Units: "_LRY,LINE=LINE+1
160 Q
Note: See TracBrowser for help on using the repository browser.