| 1 | LRSRVR2 ;DALIO/FHS - LAB DATA SERVER CONT'D RELMA EXTRACT ; Jan 9, 2006
|
---|
| 2 | ;;5.2;LAB SERVICE;**303,346**;Sep 27, 1994;Build 10
|
---|
| 3 | ; Produces LOINC RELMA extract - via LRLABSERVER or option
|
---|
| 4 | ;
|
---|
| 5 | EN ; Called by option [LR LOINC EXTRACT RELMA FORMAT]
|
---|
| 6 | ; Entry point for the option - user must capture output
|
---|
| 7 | N DIR,DIRUT,LREND,LRCNT,LRSUB,LRVAL,LRST,LRSTN,LRTXT,X,Y
|
---|
| 8 | S DIR(0)="Y",DIR("A")="Ready to Capture",DIR("B")="Yes"
|
---|
| 9 | D ^DIR
|
---|
| 10 | I $D(DIRUT) Q
|
---|
| 11 | D WAIT^DICD
|
---|
| 12 | S LRSUB="RELMA",LRTXT=1
|
---|
| 13 | D BUILD
|
---|
| 14 | W !
|
---|
| 15 | S LRL=0
|
---|
| 16 | F S LRL=$O(^TMP($J,"LRDATA",LRL)) Q:LRL<1 W !,^(LRL)
|
---|
| 17 | D CLEAN^LRSRVR2A
|
---|
| 18 | Q
|
---|
| 19 | ;
|
---|
| 20 | ;
|
---|
| 21 | SERVER ; Server entry Point
|
---|
| 22 | N I,LRCNT,LREND,LRL,LRMSUBJ,LRTXT,LRX,LRY
|
---|
| 23 | S LRTXT=0
|
---|
| 24 | D BUILD
|
---|
| 25 | S LRMSUBJ=LRST_" "_LRSTN_" RELMA EXTRACT "_$$HTE^XLFDT($H,"1M")
|
---|
| 26 | D MAILSEND^LRSRVR6(LRMSUBJ)
|
---|
| 27 | D CLEAN^LRSRVR2A
|
---|
| 28 | Q
|
---|
| 29 | ;
|
---|
| 30 | ;
|
---|
| 31 | BUILD ; Build extract
|
---|
| 32 | N I,LR6206,LR64,LRCNT,LRCRLF,LRLEN,LRQUIT,LRROOT,LRSTNOTE,LRSS,LRSTR,LRSTUB,LRVAL
|
---|
| 33 | S LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2)
|
---|
| 34 | I LRST="" S LRST="???"
|
---|
| 35 | K ^TMP($J,"LRDATA"),^TMP($J,"LR60")
|
---|
| 36 | S LRCNT=0,LRCRLF=$C(13,10),LRSTR=""
|
---|
| 37 | F I=0,1,2,3 S LRCNT(I)=0
|
---|
| 38 | D HDR^LRSRVR2A
|
---|
| 39 | ;
|
---|
| 40 | ; Step down the B X-ref - exclude synomyms
|
---|
| 41 | S LRROOT="^LAB(60,""B"")"
|
---|
| 42 | F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D
|
---|
| 43 | . Q:$G(@LRROOT)
|
---|
| 44 | . D TEST
|
---|
| 45 | ;
|
---|
| 46 | ; Process microbiology antibiotics
|
---|
| 47 | S LR6206=0,LRSS="MI"
|
---|
| 48 | F S LR6206=$O(^LAB(62.06,LR6206)) Q:'LR6206 D
|
---|
| 49 | . S LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
|
---|
| 50 | . S LRX=$$MICRO^LRSRVR3(LR64)
|
---|
| 51 | . S LRSTUB=$P(LRX,"|",5)_"||||"_$P(LRX,"|",3)_"|"_$P(LRX,"|",1)_"|||"_$P(LRX,"|",20)_"|"_$P(LRX,"|",19)_"|||||||||||"
|
---|
| 52 | . I LR64 S LRSTUB=LRSTUB_$$GET1^DIQ(64,LR64_",",25)
|
---|
| 53 | . S LRSTUB=LRSTUB_"|1.1|" ; Set extract version number
|
---|
| 54 | . S LRSTR=LRSTR_LRST_"-"_LR64_"-"_"AB"_LR6206_"|"_LRSTUB
|
---|
| 55 | . I 'LRTXT S LRSTR=LRSTR_LRCRLF
|
---|
| 56 | . D SETDATA S LRCNT=LRCNT+1,LRCNT(3)=LRCNT(3)+1
|
---|
| 57 | ;
|
---|
| 58 | ; Set the final info into the ^TMP message global
|
---|
| 59 | I 'LRTXT D
|
---|
| 60 | . S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
|
---|
| 61 | . I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
|
---|
| 62 | . S ^TMP($J,"LRDATA",LRNODE+1)=" "
|
---|
| 63 | . S ^TMP($J,"LRDATA",LRNODE+2)="end"
|
---|
| 64 | ;
|
---|
| 65 | S ^TMP($J,"LRDATA",6)="Total number of records: "_$J(LRCNT,5)
|
---|
| 66 | S ^TMP($J,"LRDATA",7)="Total number of tests..: "_$J(LRCNT(0),5)
|
---|
| 67 | S ^TMP($J,"LRDATA",8)="Tests with LOINC code..: "_$J(LRCNT(1),5)
|
---|
| 68 | S ^TMP($J,"LRDATA",9)="Tests with NLT code....: "_$J(LRCNT(2),5)
|
---|
| 69 | S ^TMP($J,"LRDATA",10)="Antimicrobials.........: "_$J(LRCNT(3),5)
|
---|
| 70 | ;
|
---|
| 71 | Q
|
---|
| 72 | ;
|
---|
| 73 | ;
|
---|
| 74 | TEST ; Pull out test info
|
---|
| 75 | N LA7TREE,LR60,LRBATTY,LRBATTYN,LRTSTTYP
|
---|
| 76 | K LROUT,LRSPEC,ERR
|
---|
| 77 | S LR60NM=$QS(LRROOT,3),LR60IEN=$QS(LRROOT,4)
|
---|
| 78 | S LR60NM=$$TRIM^XLFSTR(LR60NM,"RL"," ")
|
---|
| 79 | S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
|
---|
| 80 | ;
|
---|
| 81 | ; Bypass "neither" type tests.
|
---|
| 82 | I LRTSTTYP="N" Q
|
---|
| 83 | ; Bypass "workload" type tests.
|
---|
| 84 | I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
|
---|
| 85 | ;
|
---|
| 86 | S LRBATTY=LRST_"-"_LR60IEN,LRBATTYN=LR60NM
|
---|
| 87 | S LRBATTY=$$TRIM^XLFSTR(LRBATTY,"RL"," ")
|
---|
| 88 | ; Panel test
|
---|
| 89 | ; Bypass "output panel" type tests - usually used for display only.
|
---|
| 90 | I $O(^LAB(60,LR60IEN,2,0)) D Q
|
---|
| 91 | . I $P(^LAB(60,LR60IEN,0),"^",3)="O" Q
|
---|
| 92 | . D UNWIND^LA7ADL1(LR60IEN,9,0)
|
---|
| 93 | . S LR60=0
|
---|
| 94 | . F S LR60=$O(LA7TREE(LR60)) Q:'LR60 D
|
---|
| 95 | . . I $D(^TMP($J,"LR60",LR60)) Q
|
---|
| 96 | . . S LR60IEN=LR60,LR60NM=$P(^LAB(60,LR60IEN,0),"^")
|
---|
| 97 | . . S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
|
---|
| 98 | . . ; Bypass "neither" type tests.
|
---|
| 99 | . . I LRTSTTYP="N" Q
|
---|
| 100 | . . ; Bypass "workload" type tests.
|
---|
| 101 | . . I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
|
---|
| 102 | . . S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
|
---|
| 103 | . . D SPEC
|
---|
| 104 | ;
|
---|
| 105 | I $D(^TMP($J,"LR60",LR60IEN)) Q
|
---|
| 106 | ; Not a panel test
|
---|
| 107 | ; Get result NLT code
|
---|
| 108 | S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
|
---|
| 109 | D SPEC
|
---|
| 110 | Q
|
---|
| 111 | ;
|
---|
| 112 | ;
|
---|
| 113 | SPEC ; Check each specimen for this test
|
---|
| 114 | K LRSPEC,LROUT
|
---|
| 115 | S (LRCDEF,LRSPEC,LRSPECN,LRLNC,LRLNCN,LRLNCX,LRLNC80,LRUNIT,Y)=""
|
---|
| 116 | D SITENOTE^LRSRVR2A
|
---|
| 117 | D SYNNOTE^LRSRVR2A
|
---|
| 118 | S LRSPEC60=0
|
---|
| 119 | F S LRSPEC60=$O(^LAB(60,+LR60IEN,1,LRSPEC60)) Q:'LRSPEC60 D
|
---|
| 120 | . Q:'($D(^LAB(60,+LR60IEN,1,LRSPEC60,0))#2)
|
---|
| 121 | . S LRUNIT=$P(^LAB(60,+LR60IEN,1,LRSPEC60,0),U,7)
|
---|
| 122 | . S X=$G(^LAB(61,LRSPEC60,0))
|
---|
| 123 | . S LRSPECN=$P(X,"^"),LRSPECTA=$P(X,"^",10)
|
---|
| 124 | . S LRSPEC(LRSPEC60_"-0")=LRSPEC60_U_LRSPECN_U_LRSPECTA_U_LRUNIT_U_LRR64
|
---|
| 125 | . I LRR64,$P($$GET1^DIQ(64,LRR64_",",1,"E"),".",2)="0000" D SUFFIX^LRSRVR2A
|
---|
| 126 | D SPECLOOP
|
---|
| 127 | Q
|
---|
| 128 | ;
|
---|
| 129 | ;
|
---|
| 130 | SPECLOOP ; Check to see if specimen has been linked to LOINC
|
---|
| 131 | ;
|
---|
| 132 | N LR64,LR6421,LRINDX,LRLNTA,LRRNLT,LRTA,LRX,X
|
---|
| 133 | S LRINDX=0
|
---|
| 134 | F S LRINDX=$O(LRSPEC(LRINDX)) Q:'LRINDX D
|
---|
| 135 | . S X=LRSPEC(LRINDX)
|
---|
| 136 | . S LRSPEC=$P(X,U),LRSPECN=$P(X,U,2),LRLNTA=$P(X,U,3),LR64=$P(X,U,5),LRUNIT=$$TRIM^XLFSTR($P(X,U,4),"RL"," ")
|
---|
| 137 | . S (LR6421,LRLNC,LRRNLT,LRTA)=""
|
---|
| 138 | . I LR64 D
|
---|
| 139 | . . S LRRNLT=$$GET1^DIQ(64,LR64_",",1,"E")
|
---|
| 140 | . . S LR6421=$$GET1^DIQ(64,LR64_",",13,"I")
|
---|
| 141 | . . S LRX=""
|
---|
| 142 | . . I LRSPEC,LRLNTA S LRX=$P($G(^LAM(LR64,5,LRSPEC,1,LRLNTA,1)),"^")
|
---|
| 143 | . . I LRX="",LRSPEC D
|
---|
| 144 | . . . S X=$O(^LAM(LR64,5,LRSPEC,1,0))
|
---|
| 145 | . . . I X S LRLNTA=X,LRX=$P($G(^LAM(LR64,5,LRSPEC,1,X,1)),"^")
|
---|
| 146 | . . I LRX'="" S LRLNC=$$GET1^DIQ(95.3,LRX_",",.01,"E")
|
---|
| 147 | . . I LRLNTA S LRTA=$$GET1^DIQ(64.061,LRLNTA_",",.01,"E")
|
---|
| 148 | . D WRT
|
---|
| 149 | Q
|
---|
| 150 | ;
|
---|
| 151 | ;
|
---|
| 152 | WRT ; Set ^TMP( with extracted data
|
---|
| 153 | N LRJ,LREN,LRQUIT,LRSS,X,Y
|
---|
| 154 | ;
|
---|
| 155 | ; Set flag that this file #60 test has been processed - avoid duplicate
|
---|
| 156 | ; processing as component of panel and individual test
|
---|
| 157 | S ^TMP($J,"LR60",LR60IEN)=""
|
---|
| 158 | ;
|
---|
| 159 | S LRSTR=LRSTR_LRST_"-"_LR60IEN_"-"_LRINDX
|
---|
| 160 | S LRSTR=LRSTR_"|"_LR60NM_"|"_LRSPECN_"|"_LRTA_"|"_LRUNIT_"|"_LRLNC_"|"_LRRNLT_"|"_LRBATTY_"|"_LRBATTYN_"|"
|
---|
| 161 | ;
|
---|
| 162 | ; Lab section specified for this NLT code.
|
---|
| 163 | S LRSTR=LRSTR_$S($G(LR6421)>0:$$GET1^DIQ(64.21,LR6421_",",1),1:"")_"|"
|
---|
| 164 | ;
|
---|
| 165 | ; Subscript
|
---|
| 166 | S LRSS=$$GET1^DIQ(60,LR60IEN_",",4,"I")
|
---|
| 167 | S LRSTR=LRSTR_LRSS_"|"
|
---|
| 168 | ; Test info - data type, help prompt
|
---|
| 169 | I LRSS'="CH" S LRSTR=LRSTR_"||"
|
---|
| 170 | I LRSS="CH" S X=$$TSTTYP^LRSRVR3($$GET1^DIQ(60,LR60IEN_",",13)) S LRSTR=LRSTR_$P(X,"|")_"|"_$P(X,"|",2)_"|"
|
---|
| 171 | ;
|
---|
| 172 | ; Test reference low|reference high|therapeutic low|therapeutic high|
|
---|
| 173 | S X=$G(^LAB(60,LR60IEN,1,LRSPEC,0))
|
---|
| 174 | S Y=$P(X,"^",2)_"|"_$P(X,"^",3)_"|"_$P(X,"^",11)_"|"_$P(X,"^",12)
|
---|
| 175 | S LRSTR=LRSTR_$TR(Y,$C(34),"")
|
---|
| 176 | ; Use for reference lab testing
|
---|
| 177 | S X=$G(^LAB(60,LR60IEN,1,LRSPEC,.1))
|
---|
| 178 | S LRSTR=LRSTR_"|"_$S($P(X,"^")=1:"YES",1:"NO")_"|"
|
---|
| 179 | ;
|
---|
| 180 | ; Send site's test notes on first record for this test.
|
---|
| 181 | I LRSTNOTE D
|
---|
| 182 | . D SETDATA
|
---|
| 183 | . S LRJ="LRSTNOTE"
|
---|
| 184 | . F S LRJ=$Q(@LRJ) Q:LRJ="" D
|
---|
| 185 | . . S X=@LRJ I X["|" S X=$TR(X,"|","~")
|
---|
| 186 | . . S LRSTR=LRSTR_X D SETDATA
|
---|
| 187 | . S LRSTNOTE=0
|
---|
| 188 | S LRSTR=LRSTR_"|"
|
---|
| 189 | ;
|
---|
| 190 | ; Send site's test synonym's on first record for this test.
|
---|
| 191 | I LRSTSYN D
|
---|
| 192 | . D SETDATA
|
---|
| 193 | . S LRJ="LRSTSYN"
|
---|
| 194 | . F S LRJ=$Q(@LRJ) Q:LRJ="" S LRSTR=LRSTR_@LRJ_"^" D SETDATA
|
---|
| 195 | . S LRSTSYN=0
|
---|
| 196 | ;
|
---|
| 197 | ; Send file #60 test type
|
---|
| 198 | S LRSTR=LRSTR_"|"_LRTSTTYP_"|"
|
---|
| 199 | ;
|
---|
| 200 | ; Send default LOINC code
|
---|
| 201 | I LR64 S LRSTR=LRSTR_$$GET1^DIQ(64,LR64_",",25)
|
---|
| 202 | ;
|
---|
| 203 | ; Set extract version number
|
---|
| 204 | S LRSTR=LRSTR_"|1.1|"
|
---|
| 205 | ;
|
---|
| 206 | I 'LRTXT S LRSTR=LRSTR_LRCRLF
|
---|
| 207 | D SETDATA
|
---|
| 208 | ;
|
---|
| 209 | S LRCNT=LRCNT+1,LRCNT(0)=LRCNT(0)+1
|
---|
| 210 | I LRLNC'="" S LRCNT(1)=LRCNT(1)+1
|
---|
| 211 | I LR64 S LRCNT(2)=LRCNT(2)+1
|
---|
| 212 | Q
|
---|
| 213 | ;
|
---|
| 214 | ;
|
---|
| 215 | SETDATA ; Set data into report structure
|
---|
| 216 | S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
|
---|
| 217 | I LRTXT S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=LRSTR,LRSTR="" Q
|
---|
| 218 | I 'LRTXT D ENCODE^LRSRVR4(.LRSTR)
|
---|
| 219 | Q
|
---|