source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCF.m@ 1789

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

revised back to 6/30/08 version
File size: 6.6 KB
Line 
1PXRMCF ; SLC/PKR - Handle computed findings. ;12/15/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;=======================================================
5EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate computed findings.
6 N FIEVT,FILENUM,FINDING,FINDPA,ITEM
7 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
8 S ITEM=""
9 F S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:+ITEM=0 D
10 . S FINDING=""
11 . F S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0 D
12 .. K FINDPA
13 .. M FINDPA=DEFARR(20,FINDING)
14 .. K FIEVT
15 .. D FIEVAL(FILENUM,DFN,ITEM,.FINDPA,.FIEVT)
16 .. M FIEVAL(FINDING)=FIEVT
17 .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
18 Q
19 ;
20 ;=======================================================
21EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Patient list evaluator.
22 ;Return the list in ^TMP($J,PLIST)
23 N ITEM,FILENUM,PFINDPA
24 N TEMP,TFINDING,TFINDPA
25 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
26 S ITEM=""
27 F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
28 . S TFINDING=""
29 . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
30 .. K PFINDPA,TFINDPA
31 .. M TFINDPA=TERMARR(20,TFINDING)
32 ..;Set the finding parameters.
33 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
34 .. D GPLIST(FILENUM,ITEM,.PFINDPA,PLIST)
35 Q
36 ;
37 ;=======================================================
38EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;General term
39 ;evaluator.
40 N FIEVT,FILENUM,ITEM,PFINDPA
41 N TEMP,TFINDING,TFINDPA
42 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
43 S ITEM=""
44 F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
45 . S TFINDING=""
46 . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
47 .. K FIEVT,PFINDPA,TFINDPA
48 .. M TFINDPA=TERMARR(20,TFINDING)
49 ..;Set the finding parameters.
50 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
51 .. D FIEVAL(FILENUM,DFN,ITEM,.PFINDPA,.FIEVT)
52 .. M TFIEVAL(TFINDING)=FIEVT
53 .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
54 Q
55 ;
56 ;=======================================================
57FIEVAL(FILENUM,DFN,ITEM,PFINDPA,FIEVAL) ;
58 ;Evaluate regular patient findings.
59 N BDT,CASESEN,COND,CONVAL,DAS,DATA,DATE,EDT,FLIST,ICOND,IND
60 N NFOUND,NGET,NOCC,NP,PDATA,ROUTINE
61 N SAVE,SDIR,STATUSA,TEMP,TEST,TEXT,TYPE,UCIFS,VALUE,VSLIST
62 ;Set the finding search parameters.
63 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
64 S SDIR=$S(NOCC<0:+1,1:-1)
65 S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
66 S TEST=PFINDPA(15)
67 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
68 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC)
69 S TEMP=^PXRMD(811.4,ITEM,0)
70 S TYPE=$P(TEMP,U,5)
71 I TYPE="" S TYPE="S"
72 I TYPE="S" D
73 . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,.TEST,.DATE,.VALUE,.TEXT)"
74 . D @ROUTINE
75 .;Make sure that the date is in range.
76 . I TEST,DATE'<BDT,DATE'>EDT S NFOUND=1
77 . E S NFOUND=0
78 . I NFOUND D
79 .. S TEST(1)=TEST,DATE(1)=DATE,TEXT(1)=$G(TEXT)
80 .. S DATA(1,"VALUE")=$G(VALUE)
81 .. I $D(VALUE)=11 S IND="" F S IND=$O(VALUE(IND)) Q:IND="" S DATA(1,IND)=VALUE(IND)
82 I TYPE="M" D
83 . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)"
84 . D @ROUTINE
85 I TYPE'="S",TYPE'="M" D
86 . S NFOUND=0
87 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","COMPUTED FINDING","WRONG TYPE")=TYPE_" IS NOT SUITABLE FOR REMINDER EVALUATION"
88 I NFOUND=0 S FIEVAL=0 Q
89 S NP=0
90 F IND=1:1:NFOUND Q:NP=NOCC D
91 . I TEST(IND),COND'="" D
92 .. K PDATA M PDATA=DATA(IND)
93 .. S CONVAL=$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.PDATA)
94 . E S CONVAL=TEST(IND)
95 . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
96 . I SAVE D
97 .. S NP=NP+1
98 .. S FIEVAL(NP)=CONVAL
99 .. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
100 .. S FIEVAL(NP,"DATE")=DATE(IND)
101 .. S FIEVAL(NP,"TEXT")=$G(TEXT(IND))
102 .. M FIEVAL(NP)=DATA(IND)
103 .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=DATA(IND)
104 ;
105 ;Save the finding result.
106 D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
107 S FIEVAL("FILE NUMBER")=FILENUM
108 Q
109 ;
110 ;=======================================================
111GPLIST(FILENUM,CFIEN,PFINDPA,PLIST) ;Add to the patient list
112 ;for a regular file.
113 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DATA,DFN,FLIST
114 N ICOND,IND,IPLIST
115 N NOCC,NOCCABS,NFOUND,NGET,NP,PARAM,ROUTINE
116 N SAVE,SOURCE,STATUSA,TEMP,TEXT,TGLIST,TPLIST,TYPE
117 N UCIFS,VALUE,VSLIST
118 S TEMP=^PXRMD(811.4,CFIEN,0)
119 S TYPE=$P(TEMP,U,5)
120 I TYPE'="L" Q
121 S TGLIST="GPLIST_PXRMCF"
122 S PARAM=PFINDPA(15)
123 S SOURCE=FILENUM_";"_CFIEN
124 ;Set the finding search parameters.
125 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
126 S NOCCABS=$$ABS^XLFMTH(NOCC)
127 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
128 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCCABS)
129 K ^TMP($J,TGLIST)
130 S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(NGET,BDT,EDT,TGLIST,PARAM)"
131 D @ROUTINE
132 ;Routine should return:
133 ;^TMP($J,TGLIST,DFN,N)=DAS_U_DATE_U_FILENUM_U_ITEM_U_VALUE
134 ;Data values for condition are returned in
135 ;^TMP($J,TGLIST,DFN,N,SUB)=DATA(SUB)
136 S DFN=""
137 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
138 . K TPLIST
139 . M TPLIST=^TMP($J,TGLIST,DFN)
140 . S (IND,NFOUND)=0
141 . K IPLIST
142 . F S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCCABS) D
143 .. S TEMP=TPLIST(IND)
144 .. K DATA M DATA=TPLIST(IND)
145 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.DATA),1:1)
146 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
147 .. I SAVE D
148 ... S NFOUND=NFOUND+1
149 ... S IPLIST(CONVAL,DFN,NFOUND,SOURCE)=TEMP
150 . M ^TMP($J,PLIST)=IPLIST
151 K ^TMP($J,TGLIST)
152 Q
153 ;
154 ;=======================================================
155MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
156 N DATA,DATE,FIEN,IND,JND,NAME,NOUT,PNAME,TEMP,TEXTOUT,VALUE
157 S FIEN=$P(IFIEVAL("FINDING"),";",1)
158 S TEMP=^PXRMD(811.4,FIEN,0)
159 S PNAME=$P(TEMP,U,4)
160 I PNAME="" S PNAME=$P(TEMP,U,1)
161 S NAME="Computed Finding: "_PNAME_" = "
162 S IND=0
163 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
164 . S VALUE=$G(IFIEVAL(IND,"VALUE"))
165 . S DATE=IFIEVAL(IND,"DATE")
166 . S TEMP=NAME_VALUE_" ("_$$EDATE^PXRMDATE(DATE)_")"
167 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
168 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
169 S NLINES=NLINES+1,TEXT(NLINES)=""
170 Q
171 ;
172 ;=======================================================
173OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
174 ;maintenance output.
175 N DATA,DATE,FIEN,IND,JND,NOUT,PNAME,TEMP,TEXTOUT,VALUE
176 S FIEN=$P(IFIEVAL("FINDING"),";",1)
177 S TEMP=^PXRMD(811.4,FIEN,0)
178 S PNAME=$P(TEMP,U,4)
179 I PNAME="" S PNAME=$P(TEMP,U,1)
180 S NLINES=NLINES+1
181 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Computed Finding: "_PNAME
182 S IND=0
183 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
184 . S DATE=IFIEVAL(IND,"DATE")
185 . S TEMP=$$EDATE^PXRMDATE(DATE)
186 . S VALUE=$G(IFIEVAL(IND,"VALUE"))
187 . I VALUE'="" S TEMP=TEMP_" value - "_VALUE
188 .;If there is text append it.
189 . I $G(IFIEVAL(IND,"TEXT"))'="" S TEMP=TEMP_"; "_IFIEVAL(IND,"TEXT")
190 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
191 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
192 S NLINES=NLINES+1,TEXT(NLINES)=""
193 Q
194 ;
Note: See TracBrowser for help on using the repository browser.