source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTERM.m@ 1150

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

revised back to 6/30/08 version
File size: 9.4 KB
RevLine 
[623]1PXRMTERM ; SLC/PKR - Handle reminder terms. ;06/29/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;=============================================
5COPY(NOCC,SDIR,TFIEVAL,DATEORDR,FINDING,FIEVAL) ;Copy the NOCC date ordered
6 ;findings from TFIEVAL to FIEVAL(FINDING).
7 N DATE,IND,JND,MRS,NFOUND,TFI
8 ;Start with most recent and go to oldest finding.
9 S MRS=1
10 S NFOUND=0
11 S DATE=""
12 F S DATE=$O(DATEORDR(DATE),SDIR) Q:(NFOUND=NOCC)!(DATE="") D
13 . S TFI=0
14 . F S TFI=$O(DATEORDR(DATE,TFI)) Q:(NFOUND=NOCC)!(TFI="") D
15 .. I MRS D
16 ...;Save the main result node.
17 ... S FIEVAL(FINDING)=TFIEVAL(TFI)
18 ... S MRS=0
19 ... I 'FIEVAL(FINDING) Q
20 ... S JND="@"
21 ... F S JND=$O(TFIEVAL(TFI,JND)) Q:JND="" D
22 .... M FIEVAL(FINDING,JND)=TFIEVAL(TFI,JND)
23 .. I 'FIEVAL(FINDING) Q
24 .. S IND=0
25 .. F S IND=$O(DATEORDR(DATE,TFI,IND)) Q:(NFOUND=NOCC)!(IND="") D
26 ...;Only save true sub-results.
27 ... I 'TFIEVAL(TFI,IND) Q
28 ... S NFOUND=NFOUND+1
29 ... M FIEVAL(FINDING,NFOUND)=TFIEVAL(TFI,IND)
30 ... S FIEVAL(FINDING,NFOUND,"FILE NUMBER")=TFIEVAL(TFI,"FILE NUMBER")
31 ... S FIEVAL(FINDING,NFOUND,"FINDING")=TFIEVAL(TFI,"FINDING")
32 ... S JND=0
33 ... F S JND=$O(TFIEVAL(TFI,IND,JND)) Q:JND="" M FIEVAL(FINDING,NFOUND,JND)=TFIEVAL(TFI,IND,JND)
34 Q
35 ;
36 ;=============================================
37DORDER(TFIEVAL,DATEORDR) ;Order term findings by date, term finding,
38 ;and term finding occurrence.
39 N DATE,FI,IND
40 K DATEORDR
41 S FI=0
42 F S FI=+$O(TFIEVAL(FI)) Q:FI=0 D
43 . S IND=0
44 . F S IND=+$O(TFIEVAL(FI,IND)) Q:IND=0 D
45 .. S DATE=$G(TFIEVAL(FI,IND,"DATE"))
46 .. I DATE'="" S DATEORDR(DATE,FI,IND)=""
47 Q
48 ;
49 ;=============================================
50EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate all reminder terms in a
51 ;definition.
52 N CASESEN,CONVAL,DATE,DATEORDR
53 N FIEVT,FINDING,FINDPA,IND,NOCC
54 N SDIR,TFIND3,TFIND4,TERMARR,TERMIEN,TFI,TFIEVAL,UCIFS
55 S TERMIEN=""
56 F S TERMIEN=$O(DEFARR("E",ENODE,TERMIEN)) Q:+TERMIEN=0 D
57 . I '$D(^PXRMD(811.5,TERMIEN,20,"E")) D Q
58 .. S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFI",TERMIEN)="Warning no findings items in reminder term "_$P(^PXRMD(811.5,TERMIEN,0),U,1)
59 .. S FINDING=""
60 .. F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:FINDING="" S FIEVAL(FINDING)=0
61 . D TERM^PXRMLDR(TERMIEN,.TERMARR)
62 . S FINDING=""
63 . F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:+FINDING=0 D
64 .. S FIEVAL(FINDING)=0
65 .. S FIEVAL(FINDING,"TERM")=TERMARR(0)
66 .. S FIEVAL(FINDING,"TERM IEN")=TERMIEN
67 .. K FINDPA,TFIEVAL
68 .. M FINDPA=DEFARR(20,FINDING)
69 .. D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
70 .. I $G(PXRMTDEB) M ^TMP("PXRMTDEB",$J,FINDING)=TFIEVAL
71 ..;Set NOCC and SDIR.
72 .. S NOCC=$P(FINDPA(0),U,14)
73 .. I NOCC="" S NOCC=1
74 .. S SDIR=$S(NOCC<0:+1,1:-1)
75 .. S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
76 ..;Order the term findings by date.
77 .. D DORDER(.TFIEVAL,.DATEORDR)
78 .. D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL)
79 Q
80 ;
81 ;=============================================
82EVALPL(FINDPA,TERMARR,PLIST) ;Build a list of patients based on a
83 ;term. The list is returned in:
84 ;^TMP($J,PLIST,T/F,DFN,ITEM,NFOUND,FILENUM)=DAS_U_DATE_U_VALUE
85 ;for findings with a start and stop date the list is
86 ;^TMP($J,PLIST,T/F,DFN,ITEM,NFOUND,FILENUM)=DAS_U_START_U_STOP_U_VALUE
87 N ENODE
88 K ^TMP($J,PLIST)
89 S ENODE=""
90 F S ENODE=$O(TERMARR("E",ENODE)) Q:ENODE="" D
91 . I ENODE="AUTTEDT(" D EVALPL^PXRMEDU(.FINDPA,ENODE,.TERMARR,PLIST) Q
92 . I ENODE="AUTTEXAM(" D EVALPL^PXRMEXAM(.FINDPA,ENODE,.TERMARR,PLIST) Q
93 . I ENODE="AUTTHF(" D EVALPL^PXRMHF(.FINDPA,ENODE,.TERMARR,PLIST) Q
94 . I ENODE="AUTTIMM(" D EVALPL^PXRMIMM(.FINDPA,ENODE,.TERMARR,PLIST) Q
95 . I ENODE="AUTTSK(" D EVALPL^PXRMSKIN(.FINDPA,ENODE,.TERMARR,PLIST) Q
96 . I ENODE="GMRD(120.51," D EVALPL^PXRMVITL(.FINDPA,ENODE,.TERMARR,PLIST) Q
97 . I ENODE="LAB(60," D EVALPL^PXRMLAB(.FINDPA,ENODE,.TERMARR,PLIST) Q
98 . I ENODE="ORD(101.43," D EVALPL^PXRMORDR(.FINDPA,ENODE,.TERMARR,PLIST) Q
99 . I ENODE="PXRMD(810.9," D EVALPL^PXRMLOCL(.FINDPA,ENODE,.TERMARR,PLIST) Q
100 . I ENODE="PXD(811.2," D EVALPL^PXRMTAX(.FINDPA,ENODE,.TERMARR,PLIST) Q
101 . I ENODE="PXRMD(811.4," D EVALPL^PXRMCF(.FINDPA,ENODE,.TERMARR,PLIST) Q
102 . I ENODE="PS(50.605," D EVALPL^PXRMDRCL(.FINDPA,ENODE,.TERMARR,PLIST) Q
103 . I ENODE="PSDRUG(" D EVALPL^PXRMDRUG(.FINDPA,ENODE,.TERMARR,PLIST) Q
104 . I ENODE="PSNDF(50.6," D EVALPL^PXRMDGEN(.FINDPA,ENODE,.TERMARR,PLIST) Q
105 . I ENODE="RAMIS(71," D EVALPL^PXRMRAD(.FINDPA,ENODE,.TERMARR,PLIST) Q
106 . I ENODE="YTT(601," D EVALPL^PXRMMH(.FINDPA,ENODE,.TERMARR,PLIST) Q
107 Q
108 ;
109 ;=============================================
110EVALTERM(DFN,FINDPA,TERMARR,TFIEVAL) ;Evaluate all the findings in
111 ;a term. Use the "E" cross-reference just like the finding evaluation.
112 N ENODE
113 S ENODE=""
114 F S ENODE=$O(TERMARR("E",ENODE)) Q:ENODE="" D
115 . I ENODE="AUTTEDT(" D EVALTERM^PXRMEDU(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
116 . I ENODE="AUTTEXAM(" D EVALTERM^PXRMEXAM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
117 . I ENODE="AUTTHF(" D EVALTERM^PXRMHF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
118 . I ENODE="AUTTIMM(" D EVALTERM^PXRMIMM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
119 . I ENODE="AUTTSK(" D EVALTERM^PXRMSKIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
120 . I ENODE="GMRD(120.51," D EVALTERM^PXRMVITL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
121 . I ENODE="LAB(60," D EVALTERM^PXRMLAB(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
122 . I ENODE="ORD(101.43," D EVALTERM^PXRMORDR(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
123 . I ENODE="PXD(811.2," D EVALTERM^PXRMTAX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
124 . I ENODE="PXRMD(810.9," D EVALTERM^PXRMLOCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
125 . I ENODE="PXRMD(811.4," D EVALTERM^PXRMCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
126 . I ENODE="PS(50.605," D EVALTERM^PXRMDRCL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
127 . I ENODE="PS(55," D EVALTERM^PXRMDIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
128 . I ENODE="PS(55NVA," D EVALTERM^PXRMDNVA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
129 . I ENODE="PSDRUG(" D EVALTERM^PXRMDRUG(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
130 . I ENODE="PSRX(" D EVALTERM^PXRMDOUT(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
131 . I ENODE="PSNDF(50.6," D EVALTERM^PXRMDGEN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
132 . I ENODE="RAMIS(71," D EVALTERM^PXRMRAD(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
133 . I ENODE="YTT(601," D EVALTERM^PXRMMH(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q
134 Q
135 ;
136 ;=============================================
137IEVALTER(DFN,FINDPA,TERMARR,FINDING,FIEVAL) ;Evaluate an individual term
138 ;put the result in FIEVAL(FINDING).
139 N DATEORDR,NOCC,SDIR,TFIEVAL
140 I $D(PXRMPDEM) G DEMOK
141 N PXRMPDEM D DEM^PXRMPINF(DFN,DT,.PXRMPDEM)
142 ;Create the local demographic variables for use in Condition.
143 N PXRMAGE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX
144 S PXRMAGE=PXRMPDEM("AGE"),PXRMDOB=PXRMPDEM("DOB"),PXRMDOD=PXRMPDEM("DOD")
145 S PXRMLAD=PXRMPDEM("LAD"),PXRMSEX=PXRMPDEM("SEX")
146DEMOK S FIEVAL(FINDING)=0
147 D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL)
148 ;Set NOCC and SDIR.
149 S NOCC=$P(FINDPA(0),U,14)
150 I NOCC="" S NOCC=1
151 S SDIR=$S(NOCC<0:+1,1:-1)
152 S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
153 ;Order the term findings by date.
154 D DORDER(.TFIEVAL,.DATEORDR)
155 D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL)
156 Q
157 ;
158 ;=============================================
159MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
160 D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"MHV")
161 Q
162 ;
163 ;=============================================
164OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
165 ;maintenance output.
166 D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"CM")
167 Q
168 ;
169 ;=============================================
170OPT(INDENT,IFIEVAL,NLINES,TEXT,TYPE) ;General output.
171 N DG,DGL,DGN,DRUG,IEN,IND,JND,KND,INDENTT,FILENUM,TEMP,TIFIEVAL
172 ;If there is a drug make it available for display.
173 S DRUG=$S($D(IFIEVAL("DISPENSE DRUG")):IFIEVAL("DISPENSE DRUG"),1:"")
174 ;DBIA #10043
175 I DRUG'="" S DRUG=$P(^PSDRUG(DRUG,0),U,1)
176 ;Build the display grouping.
177 S FILENUM=IFIEVAL(1,"FILE NUMBER")
178 S IEN=$P(IFIEVAL(1,"FINDING"),";",1)
179 S DG(FILENUM,IEN)=1,DGL(1)=FILENUM_U_IEN,DGL(1,1)=""
180 S (DGN,IND)=1
181 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
182 . S FILENUM=IFIEVAL(IND,"FILE NUMBER")
183 . S IEN=$P(IFIEVAL(IND,"FINDING"),";",1)
184 . I '$D(DG(FILENUM,IEN)) D
185 .. S DGN=DGN+1,DG(FILENUM,IEN)=DGN
186 .. S DGL(DGN)=FILENUM_U_IEN,DGL(DGN,IND)=""
187 . I $D(DG(FILENUM,IEN)) D
188 .. S TEMP=DG(FILENUM,IEN),DGL(TEMP,IND)=""
189 S INDENTT=INDENT+1
190 S TEMP=$$INSCHR^PXRMEXLC(INDENT," ")_"Reminder Term: "_$P(FIEVAL(FINDING,"TERM"),U,1)
191 S NLINES=NLINES+1,TEXT(NLINES)=TEMP
192 F IND=1:1:DGN D
193 . K TIFIEVAL
194 . S (JND,KND)=0
195 . F S JND=$O(DGL(IND,JND)) Q:JND="" D
196 .. S KND=KND+1
197 .. I KND=1 M TIFIEVAL=IFIEVAL(JND)
198 .. M TIFIEVAL(KND)=IFIEVAL(JND)
199 .. I DRUG'="" S TIFIEVAL("DISPENSE DRUG")=DRUG
200 . I TYPE="CM" D FOUT^PXRMOUTC(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
201 . I TYPE="MHV" D FOUT^PXRMOUTM(INDENTT,.TIFIEVAL,.NLINES,.TEXT)
202 Q
203 ;
204 ;=============================================
205SPFINDPA(FINDPA,TFINDPA,PFINDPA) ;Set the finding parameter array
206 ;for terms.
207 N FIND0,PIECE,PFIND0,TFIND0,VAL
208 S FIND0=$G(FINDPA(0))
209 S (PFIND0,TFIND0)=TFINDPA(0)
210 ;Set the 0 node.
211 F PIECE=9,10,12,13,14,15,16 D
212 . S VAL=$P(TFIND0,U,PIECE)
213 . I VAL="" S VAL=$P(FIND0,U,PIECE)
214 . S $P(PFIND0,U,PIECE)=VAL
215 ;BDT and EDT are treated as a pair.
216 I $P(TFIND0,U,8)="",$P(TFIND0,U,11)="" F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(FIND0,U,PIECE)
217 E F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(TFIND0,U,PIECE)
218 S PFINDPA(0)=PFIND0
219 I $P($G(TFINDPA(3)),U,1)'="" S PFINDPA(3)=TFINDPA(3),PFINDPA(10)=TFINDPA(10),PFINDPA(11)=TFINDPA(11)
220 E S PFINDPA(3)=$G(FINDPA(3)),PFINDPA(10)=$G(FINDPA(10)),PFINDPA(11)=$G(FINDPA(11))
221 ;Get the status list.
222 I $D(TFINDPA(5)) M PFINDPA(5)=TFINDPA(5)
223 E M PFINDPA(5)=FINDPA(5)
224 I $D(TFINDPA(15)) S PFINDPA(15)=TFINDPA(15)
225 E S PFINDPA(15)=$G(FINDPA(15))
226 Q
227 ;
Note: See TracBrowser for help on using the repository browser.