source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPI.m@ 1046

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

initial load of WorldVistAEHR
File size: 7.9 KB
Line 
1LREPI ;DALOI/SED-EMERGING PATHOGENS SEARCH ;5/1/98
2 ;;5.2;LAB SERVICE;**132,175,260,281**;Sep 27, 1994
3 ; Reference to ^DGPT supported by IA #418
4 ; Reference to ^ICD9 supported by IA #10082
5 ; Reference to ^ORD(101 supported by IA #872
6 ; Reference to PATS^PXRMXX supported by IA #3134
7TEST S LRRPS=3000501,LRRPE=3000531,LRRTYPE=1
8 S LREPI(2)="",LREPI(17)="",LREPI(18)="",LREPI(19)=""
9 ;S D0=0 F S D0=$O(^LAB(69.5,D0)) Q:+D0'>0 D
10 ;.Q:$P(^LAB(69.5,D0,0),U,2)="1"
11 ;.Q:$P(^LAB(69.5,D0,0),U,7)=""
12 ;.Q:'$D(^ORD(101,$P(^LAB(69.5,D0,0),U,7),0))
13 ;.S LREPI(D0)=""
14 S LRBEG=9999999-(LRRPE+.9),LREND=9999999-LRRPS+.999999
15EN ;
16 ;
17INIT ;Set up search criteria
18 ;Fix start and stop date problem CKA 6/2/2002
19 S LRBEG=(9999999-LRRPE)_".0000001",LREND=9999999-LRRPS+.999999
20 K ^TMP($J),^TMP("HLS",$J)
21 S D0=0 F S D0=$O(LREPI(D0)) Q:+D0'>0 D
22 .S ^TMP($J,$P(^LAB(69.5,D0,0),U,7))=""
23 .S:$P(^LAB(69.5,D0,0),U,8)=1 ^TMP($J,"LREPI",D0)=""
24 .S LRPROT=$P(^LAB(69.5,D0,0),U,7)
25 .Q:LRPROT=""
26 .S D1=0 F S D1=$O(^LAB(69.5,D0,1,D1)) Q:+D1'>0 D
27 ..S TST=$P(^LAB(69.5,D0,1,D1,0),U)
28 ..Q:'$D(^LAB(60,TST,0))
29 ..Q:$P(^LAB(60,TST,0),U,4)=""
30 ..I $P(^LAB(60,TST,0),U,4)="CH" D
31 ...Q:$P(^LAB(60,TST,0),U,5)=""
32 ...S ^TMP($J,"T",TST,D0)=""
33 ...S ^TMP($J,"TPROT",TST,LRPROT)=""
34 ...S LRIND=$P(^LAB(69.5,D0,1,D1,0),U,2,3)
35 ...S ^TMP($J,$P(^LAB(60,TST,0),U,4),TST)=$P(^LAB(60,TST,0),U,5)_U_LRIND
36 ..I $P(^LAB(60,TST,0),U,4)="CY" D
37 ...S ^TMP($J,"T",TST,D0)=""
38 ...S ^TMP($J,$P(^LAB(60,TST,0),U,4),TST)=""
39 .S D1=0 F S D1=$O(^LAB(69.5,D0,2,D1)) Q:+D1'>0 S ^TMP($J,"E",$P(^LAB(69.5,D0,2,D1,0),U),D0)=""
40 .S D1=0 F S D1=$O(^LAB(69.5,D0,9,D1)) Q:+D1'>0 S ^TMP($J,"SNO",$P(^LAB(69.5,D0,9,D1,0),U),D0)=""
41 .S D1=0 F S D1=$O(^LAB(69.5,D0,3,D1)) Q:+D1'>0 S ^TMP($J,"ICD",$P(^LAB(69.5,D0,3,D1,0),U),D0)=""
42 K D0,D1,TST,LRIND
43 I $D(^TMP($J,"LREPI")) D SEARCH^LREPI4
44 I $D(^TMP($J,"ICD")) D PTF^LREPI5
45LAB63 ;Search file 63 for lab data
46 K LRIND
47 S LRDFN=0 F S LRDFN=$O(^LR(LRDFN)) Q:+LRDFN'>0 D
48 .Q:'$D(^LR(LRDFN,0))
49 .Q:$P(^LR(LRDFN,0),U,2)'=2
50 .S LRPAT=$P(^LR(LRDFN,0),U,3)
51 .I $D(^TMP($J,"CH")) D CH
52 .I $D(^TMP($J,"CY")) D CYTST^LREPICY
53 .I $D(^TMP($J,"E")) D MI
54 .;I '$D(^TMP($J,"ICD"))&($D(^TMP($J,"SNO"))) D CY^LREPICY
55 .I $D(^TMP($J,"SNO")) D CY^LREPICY
56 ;Retrieve patient list from Clinical Reminders
57 S LRPROTX=$O(^ORD(101,"B","LREPI",""))
58 I LRPROTX]"" S LRSRXX="",LRSRGO=0 F S LRSRXX=$O(LREPI(LRSRXX)) Q:'LRSRXX I $G(^LAB(69.5,LRSRXX,0))["HEPATITIS" D Q
59 . D PATS^PXRMXX(LRRPS,LRRPE,"LREPISRCH")
60 . S EPISRCH=0 F S EPISRCH=$O(^TMP("LREPISRCH",$J,EPISRCH)) Q:'EPISRCH D
61 . . S LRENCDT=$P(^TMP("LREPISRCH",$J,EPISRCH),"^") Q:'LRENCDT
62 . . Q:$D(^TMP($J,LRPROTX,EPISRCH,LRENCDT)) ;Encounter date already exists, don't update
63 . . S ^TMP($J,LRPROTX,EPISRCH,LRENCDT)=$P(^TMP("LREPISRCH",$J,EPISRCH),"^",2)
64 I $G(LRREP) D ^LREPI2A
65 I '$G(LRREP) D ^LREPI2
66EXIT ;EXIT
67 S D0=0
68 I $G(LRRTYPE)=0 F S D0=$O(LREPI(D0)) Q:+D0'>0 D
69 .S $P(^LAB(69.5,D0,0),U,4)=DT
70 K LREPI,DFN,CNT,DA,DIE,DR,DQ,HL,ENTRY,ENDT,ENC,FD,HLECH,HLFS,HLN,HLQ
71 K DDER,D0,HLRST,HLSAN,LRBEG,LRCNT,LRCS,LRDATE,LRDFN,LREFG,LRENCDT
72 K LREND,LRETND,LRHL7,LRINV,LRINVD,LRITN,LRND,LRNL,LRNLT,LRNTE,LROBR
73 K LRPAT,LRPFG,LRPID,LRPROT,LRPV1,LRRPE,LRRPS,LRRTYPE,LRTND,LRTNM,MSG
74 K MSGCNT,PTF,RR,SEG,SP,STDT,TST,UN,TSTNM,VAERR,X,XCNP,XMDUZ,XMZ,ZTSK
75 K AF,D,DI,LRENT,LRIND,LRPATH,OV,LRENDT,ADMDT,EPISITE,EPISRCH
76 K LR31799Z,LRANTI,LRCHK,LRIC,LRIEN,LRIPT,LRMG,LRMGN,LRNX,LRO,LROK
77 K LROVR,LRPCNT,LRPTOT,LRSI,LRSITE,LRCYSP,LRDIS,LRDISI,LRIC,LRICD
78 K LRICDI,LRIEN,LRIPT,LRMG,LRMGN,LRMOR,LRMORI,LRMSG,PXRMITEM
79 K LRSNM,LRSNO,LRSTOP,LRSUB,LRTOP,LRTOPP,LRWKI,LRPRO,LRPROI
80 K LRNDC,LRNTE1,LRFIND,LRDRUG,LRCODE,LRDRSEQ,HLHDR,HLMTIEN,HLMTIENS
81 K HLNEXT,HLNODE,HLQUIT,HLRESLT,HLRESLTA,LRANS,LRDRSQ1,LRPROTX,LRPTY
82 K LRPVVV,LRSRGO,LRSRXX,LRTOLD,LRTRM,LRPREV,LRPRECYC,X1,X2,X3
83 K LRANTIND,LRANTINV,LRREP,LRPV1NUM
84 Q
85ENCT ;SET THE ENCOUNTER FOR PV1
86 S LRPROT=$P(^LAB(69.5,LRPATH,0),U,7)
87 S LRCHK=0 D ADDCHK^LREPI5 Q:LRCHK
88 S LRDATE=9999999-LRINV
89 K VAIN,DFN,VAINDT S DFN=LRPAT,VAINDT=LRDATE D INP^VADPT
90 S LRENCDT=$S(VAIN(7)'="":$P(VAIN(7),U),1:LRDATE)
91 I $P(^LAB(69.5,LRPATH,0),U,8)=1 D CHECK^LREPI4
92 S:'$D(^TMP($J,LRPROT,LRPAT,LRENCDT)) ^TMP($J,LRPROT,LRPAT,LRENCDT)=$S(VAIN(7)'="":"I",1:"O")_U_$G(VAIN(10))
93 S:$P(^TMP($J,LRPROT,LRPAT,LRENCDT),U)="O" ^(LRENCDT)="O"_U_$S($D(LRPATLOC):LRPATLOC,1:"")
94 S:'$D(^TMP($J,LRPROT,LRPAT,LRENCDT,LRPATH,LRINV,ND)) ^TMP($J,LRPROT,LRPAT,LRENCDT,LRPATH,LRINV,ND)=""
95 I $G(LRANTIND)="",$G(LRANTINV)="" Q
96 S:'$D(^TMP($J,LRPROT,LRPATH,LRENCDT,LRPAT,LRINV,ND,LRANTIND,LRANTINV)) ^TMP($J,LRPROT,LRPAT,LRENCDT,LRPATH,LRINV,ND,LRANTIND,LRANTINV)=""
97 Q
98CH ;Check the 'CH' node
99 S LRINV=LRBEG
100 F S LRINV=$O(^LR(LRDFN,"CH",LRINV)) Q:+LRINV'>0!(LRINV>LREND) D
101 .Q:$P(^LR(LRDFN,"CH",LRINV,0),U,3)=""
102 .S LRCNT=1,LRTST=0 F S LRTST=$O(^TMP($J,"CH",LRTST)) Q:+LRTST'>0 D
103 ..S LRND=$P($P(^TMP($J,"CH",LRTST),";",2),U,1) Q:+LRND'>0
104 ..S LRPC=$P($P(^TMP($J,"CH",LRTST),";",3),U,1) Q:+LRPC'>0
105 ..S LRRES=$P($G(^LR(LRDFN,"CH",LRINV,LRND)),U,LRPC) Q:LRRES=""
106 ..S LRPATLOC=$P(^LR(LRDFN,"CH",LRINV,0),U,13)
107 ..S ^TMP($J,"TST",LRTST)=+$G(^TMP($J,"TST",LRTST))+1
108 ..S ^TMP($J,"TST",LRTST,LRDFN)=""
109 ..S LRPATH=0 F S LRPATH=$O(^TMP($J,"T",LRTST,LRPATH)) Q:+LRPATH'>0 D CHKIND
110 K LRTST,LRND,LRPC,LRRES,LRNO
111 Q
112CHKIND ;Check the results
113 I '$D(^LAB(69.5,LRPATH,1,"B",LRTST)) Q
114 S LRITST=0,ND="CH",LRNO=0
115 F S LRITST=$O(^LAB(69.5,LRPATH,1,"B",LRTST,LRITST)) Q:+LRITST'>0 D D:'LRNO ENCT
116 .S LRNO=0
117 .S LRIND=$P(^LAB(69.5,LRPATH,1,LRITST,0),U,2,3)
118 .Q:$P(LRIND,U,1)=""
119 .I $P(LRIND,U,1)=1 D Q
120 ..Q:'LRRES#2
121 ..S LRSPEC=$P($G(^LR(LRDFN,"CH",LRINV,0)),U,5) Q:LRSPEC=""
122 ..Q:'$D(^LAB(60,LRTST,1,LRSPEC,0))
123 ..S LRLOW=$P(^LAB(60,LRTST,1,LRSPEC,0),U,2),LRHIG=$P(^(0),U,3)
124 ..Q:'LRLOW#2!('LRHIG#2)
125 ..I LRRES<LRLOW!(LRRES>LRHIG) Q
126 ..S LRNO=1
127 .I $P(LRIND,U,2)="" Q
128 .S LRRES=$$UP^XLFSTR(LRRES),LRIND=$$UP^XLFSTR(LRIND)
129 .I $P(LRIND,U,1)=2,(LRRES[$P(LRIND,U,2)) Q
130 .I $P(LRIND,U,1)=3,(LRRES>$P(LRIND,U,2)) Q
131 .I $P(LRIND,U,1)=4,(LRRES<$P(LRIND,U,2)) Q
132 .I $P(LRIND,U,1)=5,(LRRES=$P(LRIND,U,2)) Q
133 .S LRNO=1
134 K LRITST,LRLOW,LRHIG,LRSPEC
135 Q
136MI ;Check the 'MI' node
137 S LRINV=LRBEG
138 F S LRINV=$O(^LR(LRDFN,"MI",LRINV)) Q:+LRINV'>0!(LRINV>LREND) D
139 .S LRCNT=1
140 .F LRMIND=3,6,9,12,17 S LRETND=0 F S LRETND=$O(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND)) Q:+LRETND'>0 D
141 ..I LRMIND=3,$P($G(^LR(LRDFN,"MI",LRINV,1)),U,2)'="F" Q
142 ..I LRMIND'=3,$P($G(^LR(LRDFN,"MI",LRINV,(LRMIND-1))),U,2)'="F" Q
143 ..S LRETI=$P($G(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,0)),U)
144 ..Q:+LRETI'>0
145 ..Q:'$D(^TMP($J,"E",LRETI))
146 ..S ^TMP($J,"EPROT",LRETI)=""
147 ..S ^TMP($J,"ETI",LRETI)=+$G(^TMP($J,"ETI",LRETI))+1
148 ..S ^TMP($J,"ETI",LRETI,LRDFN)=""
149 ..S LRPATH=0 F S LRPATH=$O(^TMP($J,"E",LRETI,LRPATH)) Q:+LRPATH'>0 D
150 ...S ND="MI"
151 ...D TOP Q:LRTOP
152 ...I LRMIND=3 D ANTI Q
153 ...D ENCT
154 K LRMIND,LRETI
155 Q
156TOP ;CHECK TO SEE IF SCREEN ON SITE
157 S LRTOP=0
158 S LRSITE=$P($G(^LR(LRDFN,"MI",LRINV,0)),U,5) Q:+LRSITE'>0
159 I ($O(^LAB(69.5,LRPATH,5,0))="")&($O(^LAB(69.5,LRPATH,6,0))="") Q
160 I ($O(^LAB(69.5,LRPATH,5,0))'="")&($O(^LAB(69.5,LRPATH,6,0))'="") Q
161 I ($O(^LAB(69.5,LRPATH,5,0))'="")&($D(^LAB(69.5,LRPATH,5,"B",LRSITE))) Q
162 I ($O(^LAB(69.5,LRPATH,6,0))'="")&('$D(^LAB(69.5,LRPATH,6,"B",LRSITE))) Q
163 S LRTOP=1
164 Q
165ANTI ;LOOK FOR THE ANTIMICROBIAL SUS FOR ORGANISMS
166 I $O(^LAB(69.5,LRPATH,4,0))="" D ENCT Q
167 S LRANTI=0 F S LRANTI=$O(^LAB(69.5,LRPATH,4,LRANTI)) Q:+LRANTI'>0 D
168 .S LRANT=$G(^LAB(69.5,LRPATH,4,LRANTI,0),U),LRANTIND=$P(^(0),U,2),LRANTINV=$P(^(0),U,3) Q:+LRANT'>0
169 .S LRAND=$P($G(^LAB(62.06,LRANT,0)),U,2) Q:LRAND=""
170 .Q:'$D(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND))
171 .Q:$P(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND),U,2)=""
172 .Q:$$UP^XLFSTR($E($P($G(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND)),U,2),1,1))="S"
173 .D ENCT
174 .;CHECK MIC VALUES
175 .I LRANTIND=""!(LRANTINV="") Q
176 .S LRRES=$$UP^XLFSTR($E($P($G(^LR(LRDFN,"MI",LRINV,LRMIND,LRETND,LRAND)),U,2),1,1)),LRANTINV=$$UP^XLFSTR(LRANTINV),LRANTIND=$$UP^XLFSTR(LRANTIND)
177 .I LRANTIND=1,(LRRES[LRANTINV) D ENCT Q
178 .I LRANTIND=2,(LRRES>LRANTINV) D ENCT Q
179 .I LRANTIND=3,(LRRES<LRANTINV) D ENCT Q
180 .I LRANTIND=4,(LRRES=LRANTINV) D ENCT Q
181 Q
182 ;
Note: See TracBrowser for help on using the repository browser.