source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTAX.m@ 1005

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

revised back to 6/30/08 version

File size: 7.8 KB
Line 
1PXRMTAX ; SLC/PKR - Handle taxonomy finding. ;07/17/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;==================================================
5EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate taxonomy findings.
6 N FIEVT,FINDPA,FINDING
7 N TAXIEN
8 S TAXIEN=""
9 F S TAXIEN=$O(DEFARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0 D
10 . S FINDING=""
11 . F S FINDING=$O(DEFARR("E",ENODE,TAXIEN,FINDING)) Q:+FINDING=0 D
12 .. K FINDPA
13 .. M FINDPA=DEFARR(20,FINDING)
14 .. K FIEVT
15 .. D FIEVAL(DFN,TAXIEN,.FINDPA,.FIEVT)
16 .. M FIEVAL(FINDING)=FIEVT
17 Q
18 ;
19 ;==================================================
20EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate taxonomy terms for
21 ;building patient lists.
22 N PFIND3,PFIND4,PFINDPA,TAXIEN
23 N TFINDPA,TFINDING
24 S TAXIEN=""
25 F S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0 D
26 . S TFINDING=""
27 . F S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0 D
28 .. K PFINDPA,TFINDPA
29 .. M TFINDPA=TERMARR(20,TFINDING)
30 ..;Set the finding parameters.
31 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
32 .. D GPLIST(TAXIEN,.PFINDPA,PLIST)
33 Q
34 ;
35 ;==================================================
36EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate taxonomy
37 ;terms.
38 N FIEVT,PFINDPA
39 N TAXIEN,TFINDPA,TFINDING
40 S TAXIEN=""
41 F S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0 D
42 . S TFINDING=""
43 . F S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0 D
44 .. K FIEVT,PFINDPA,TFINDPA
45 .. M TFINDPA=TERMARR(20,TFINDING)
46 ..;Set the finding parameters.
47 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
48 .. D FIEVAL(DFN,TAXIEN,.PFINDPA,.FIEVT)
49 .. M TFIEVAL(TFINDING)=FIEVT
50 Q
51 ;
52 ;==================================================
53FIEVAL(DFN,TAXIEN,FINDPA,FIEVAL) ;
54 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,ENS,FIEVT,FILENUM,FLIST
55 N ICOND,IND,INS,INVFD
56 N NFOUND,NGET,NICD0,NICD9,NCPT,NOCC,NP,NRCPT,PLS
57 N RAS,SAVE,SDIR,STATUSA,TAXARR,TLIST,UCIFS,USEINP,VSLIST
58 ;Set the finding search parameters.
59 D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
60 S INVFD=$P(FINDPA(0),U,16)
61 D TAX^PXRMLDR(TAXIEN,.TAXARR)
62 I TAXARR(0)["NO LOCK" S FIEVAL(1)=0 Q
63 D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS)
64 D SCPAR^PXRMCOND(.FINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
65 S SDIR=$S(NOCC<0:+1,1:-1)
66 S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
67 S NGET=$S(UCIFS:"*",1:NOCC)
68 ;
69 I (NICD0>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD0",.TLIST)
70 ;
71 I (NICD9>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD9",.TLIST)
72 I (NICD9>0),ENS D FPDAT^PXRMVPOV(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
73 I (NICD9>0),PLS D
74 . K STATUSA
75 . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
76 . D FPDAT^PXRMPROB(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.STATUSA,.TLIST)
77 ;
78 I (NCPT>0),(ENS) D FPDAT^PXRMVCPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
79 ;
80 I (NRCPT>0),(RAS) D
81 . K STATUSA
82 . D GETSTATI^PXRMSTAT(70,.FINDPA,.STATUSA)
83 . D FPDAT^PXRMRCPT(DFN,.TAXARR,NOCC,BDT,EDT,.STATUSA,.TLIST)
84 ;
85 ;Process the found list, returning the NOCC most recent results.
86 S NFOUND=0
87 S DATE=""
88 F S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCC) D
89 . S IND=0
90 . F S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NOCC) D
91 .. S FILENUM=0
92 .. F S FILENUM=$O(TLIST(DATE,IND,FILENUM)) Q:FILENUM="" D
93 ... S NFOUND=NFOUND+1
94 ... S DAS=$P(TLIST(DATE,IND,FILENUM),U,1)
95 ... S FLIST(NFOUND)=TLIST(DATE,IND,FILENUM)
96 ... S FLIST(NFOUND)=DAS_U_DATE_U_FILENUM_U_$P(TLIST(DATE,IND,FILENUM),U,2,10)
97 I NFOUND=0 S FIEVAL=0 Q
98 S NP=0
99 F IND=1:1:NFOUND Q:NP=NOCC D
100 . S DAS=$P(FLIST(IND),U,1)
101 . S FILENUM=$P(FLIST(IND),U,3)
102 . D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
103 . I $D(FIEVT("VISIT")) D GETDATA^PXRMVSIT(FIEVT("VISIT"),.FIEVT,0)
104 . S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVT),1:1)
105 . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
106 . I SAVE D
107 .. S NP=NP+1
108 .. S FIEVAL(NP)=CONVAL
109 .. S FIEVAL(NP,"CONDITION")=CONVAL
110 .. S FIEVAL(NP,"CODEP")=$P(FLIST(IND),U,4)
111 .. S FIEVAL(NP,"DAS")=DAS
112 .. S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2)
113 .. S FIEVAL(NP,"FILE NUMBER")=FILENUM
114 .. S FIEVAL(NP,"FILE SPECIFIC")=$P(FLIST(IND),U,5,10)
115 .. S FIEVAL(NP,"FINDING")=TAXIEN_";PXD(811.2,"
116 .. M FIEVAL(NP)=FIEVT
117 .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVT
118 ;Save the finding result.
119 D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
120 Q
121 ;
122 ;==================================================
123GPLIST(TAXIEN,FINDPA,PLIST) ;Get the list of patients with
124 ;taxonomy TAXIEN. Return the list as:
125 ; ^TMP($J,PLIST,T/F,DFN,TAXIEN,COUNT,FILE NUMBER)
126 ; =DAS^DATE^CODE^TYPE^file specific. TAXIEN is like the item for
127 ;non-taxonomy findings.
128 N BDT,COND,DATE,DFN,DLIST,EDT,ENS,FILENUM
129 N ICOND,IND,INS,IPLIST
130 N NF,NFOUND,NICD0,NICD9,NCPT,NF,NGET,NOCC,NRCPT
131 N PLS,RAS,STATUSA,UCIFS,USEINP,TAXARR,TF,TLIST,VSLIST
132 ;Set the finding search parameters.
133 S TLIST="GPLIST_PXRMTAX"
134 K ^TMP($J,TLIST)
135 D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
136 D TAX^PXRMLDR(TAXIEN,.TAXARR)
137 D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS)
138 D SCPAR^PXRMCOND(.FINDPA,.COND,.UCIFS,.ICOND,.VSLIST)
139 ;
140 I (NICD0>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD0",TLIST)
141 ;
142 I (NICD9>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD9",TLIST)
143 I (NICD9>0),PLS D
144 . K STATUSA
145 . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
146 . D GPLIST^PXRMPROB(.TAXARR,NOCC,BDT,EDT,.STATUSA,TLIST)
147 I (NICD9>0),ENS D GPLIST^PXRMVPOV(.TAXARR,NOCC,BDT,EDT,TLIST)
148 ;
149 I (NCPT>0),ENS D GPLIST^PXRMVCPT(.TAXARR,NOCC,BDT,EDT,TLIST)
150 ;
151 I (NRCPT>0),RAS D GPLIST^PXRMRCPT(.TAXARR,.FINDPA,TLIST)
152 ;Conditions for taxonomies only apply to radiology findings, this
153 ;is taken care of in PXRMRCPT.
154 ;Process the found list, return up to NOCC of the most recent entries.
155 F TF=0,1 D
156 . I '$D(^TMP($J,TLIST,TF)) Q
157 . S DFN=""
158 . F S DFN=$O(^TMP($J,TLIST,TF,DFN)) Q:DFN="" D
159 .. K DLIST,IPLIST
160 .. S NFOUND=0
161 .. S NF=""
162 .. F S NF=$O(^TMP($J,TLIST,TF,DFN,NF),-1) Q:NF="" D
163 ... S FILENUM=0
164 ... F S FILENUM=$O(^TMP($J,TLIST,TF,DFN,NF,FILENUM)) Q:FILENUM="" D
165 .... S NFOUND=NFOUND+1
166 .... S DATE=$P(^TMP($J,TLIST,TF,DFN,NF,FILENUM),U,2)
167 .... S DLIST(DATE,NFOUND)=NF_U_FILENUM
168 ..;
169 .. S DATE="",NFOUND=0
170 .. F S DATE=$O(DLIST(DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D
171 ... S NF=0
172 ... F S NF=$O(DLIST(DATE,NF)) Q:(NF="")!(NFOUND=NOCC) D
173 .... S NFOUND=NFOUND+1
174 .... S IND=$P(DLIST(DATE,NF),U,1)
175 .... S FILENUM=$P(DLIST(DATE,NF),U,2)
176 .... S IPLIST(TF,DFN,TAXIEN,NFOUND,FILENUM)=^TMP($J,TLIST,TF,DFN,IND,FILENUM)
177 .. M ^TMP($J,PLIST)=IPLIST
178 K ^TMP($J,TLIST)
179 Q
180 ;
181 ;==================================================
182MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
183 N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
184 S IND=0
185 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
186 S FILENUM=""
187 F S FILENUM=$O(FNA(FILENUM)) Q:FILENUM="" D
188 . K OCCLIST
189 . M OCCLIST=FNA(FILENUM)
190 . I FILENUM=45 D MHVOUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
191 . I FILENUM=70 D MHVOUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
192 . I FILENUM=9000010.07 D MHVOUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
193 . I FILENUM=9000010.18 D MHVOUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
194 . I FILENUM=9000011 D MHVOUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
195 Q
196 ;
197 ;==================================================
198OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
199 ;maintenance output.
200 N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
201 S IND=0
202 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
203 S FILENUM=""
204 F S FILENUM=$O(FNA(FILENUM)) Q:FILENUM="" D
205 . K OCCLIST
206 . M OCCLIST=FNA(FILENUM)
207 . I FILENUM=45 D OUTPUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
208 . I FILENUM=70 D OUTPUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
209 . I FILENUM=9000010.07 D OUTPUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
210 . I FILENUM=9000010.18 D OUTPUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
211 . I FILENUM=9000011 D OUTPUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
212 Q
213 ;
Note: See TracBrowser for help on using the repository browser.