source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCF.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1PXRMCF ; SLC/PKR - Handle computed findings. ;07/25/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
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 TEST=PFINDPA(15)
66 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
67 S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
68 ;Make sure NGET has the same sign as NOCC.
69 I NGET'=NOCC S NGET=NGET*($$ABS^XLFMTH(NOCC)/NOCC)
70 S TEMP=^PXRMD(811.4,ITEM,0)
71 S TYPE=$P(TEMP,U,5)
72 I TYPE="" S TYPE="S"
73 I TYPE="S" D
74 . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,.TEST,.DATE,.VALUE,.TEXT)"
75 . D @ROUTINE
76 .;Make sure that the date is in range.
77 . I TEST,DATE'<BDT,DATE'>EDT S NFOUND=1
78 . E S NFOUND=0
79 . I NFOUND D
80 .. S TEST(1)=TEST,DATE(1)=DATE,TEXT(1)=$G(TEXT)
81 .. S DATA(1,"VALUE")=$G(VALUE)
82 .. I $D(VALUE)=11 S IND="" F S IND=$O(VALUE(IND)) Q:IND="" S DATA(1,IND)=VALUE(IND)
83 I TYPE="M" D
84 . S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(DFN,NGET,BDT,EDT,.NFOUND,.TEST,.DATE,.DATA,.TEXT)"
85 . D @ROUTINE
86 I TYPE'="S",TYPE'="M" D
87 . S NFOUND=0
88 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","COMPUTED FINDING","WRONG TYPE")=TYPE_" IS NOT SUITABLE FOR REMINDER EVALUATION"
89 I NFOUND=0 S FIEVAL=0 Q
90 S NP=0
91 F IND=1:1:NFOUND Q:NP=NOCC D
92 . I TEST(IND),COND'="" D
93 .. K PDATA M PDATA=DATA(IND)
94 .. S CONVAL=$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.PDATA)
95 . E S CONVAL=TEST(IND)
96 . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
97 . I SAVE D
98 .. S NP=NP+1
99 .. S FIEVAL(NP)=CONVAL
100 .. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
101 .. S FIEVAL(NP,"DATE")=DATE(IND)
102 .. S FIEVAL(NP,"TEXT")=$G(TEXT(IND))
103 .. M FIEVAL(NP)=DATA(IND)
104 .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=DATA(IND)
105 ;
106 ;Save the finding result.
107 D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
108 S FIEVAL("FILE NUMBER")=FILENUM
109 Q
110 ;
111 ;=======================================================
112GPLIST(FILENUM,CFIEN,PFINDPA,PLIST) ;Add to the patient list
113 ;for a regular file.
114 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DATA,DFN,FLIST
115 N ICOND,IND,IPLIST
116 N NOCC,NOCCABS,NFOUND,NGET,NP,PARAM,ROUTINE
117 N SAVE,SOURCE,STATUSA,TEMP,TEXT,TGLIST,TPLIST,TYPE
118 N UCIFS,VALUE,VSLIST
119 S TEMP=^PXRMD(811.4,CFIEN,0)
120 S TYPE=$P(TEMP,U,5)
121 I TYPE'="L" Q
122 S TGLIST="GPLIST_PXRMCF"
123 S PARAM=PFINDPA(15)
124 S SOURCE=FILENUM_";"_CFIEN
125 ;Set the finding search parameters.
126 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
127 S NOCCABS=$$ABS^XLFMTH(NOCC)
128 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
129 S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCCABS)
130 K ^TMP($J,TGLIST)
131 S ROUTINE=$P(TEMP,U,3)_"^"_$P(TEMP,U,2)_"(NGET,BDT,EDT,TGLIST,PARAM)"
132 D @ROUTINE
133 ;Routine should return:
134 ;^TMP($J,TGLIST,DFN,N)=DAS_U_DATE_U_FILENUM_U_ITEM_U_VALUE
135 ;Data values for condition are returned in
136 ;^TMP($J,TGLIST,DFN,N,SUB)=DATA(SUB)
137 S DFN=""
138 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
139 . K TPLIST
140 . M TPLIST=^TMP($J,TGLIST,DFN)
141 . S (IND,NFOUND)=0
142 . K IPLIST
143 . F S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCCABS) D
144 .. S TEMP=TPLIST(IND)
145 .. K DATA M DATA=TPLIST(IND)
146 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.DATA),1:1)
147 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
148 .. I SAVE D
149 ... S NFOUND=NFOUND+1
150 ... S IPLIST(CONVAL,DFN,NFOUND,SOURCE)=TEMP
151 . M ^TMP($J,PLIST)=IPLIST
152 K ^TMP($J,TGLIST)
153 Q
154 ;
155 ;=======================================================
156MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
157 N DATA,DATE,FIEN,IND,JND,NAME,NOUT,PNAME,TEMP,TEXTOUT,VALUE
158 S FIEN=$P(IFIEVAL("FINDING"),";",1)
159 S TEMP=^PXRMD(811.4,FIEN,0)
160 S PNAME=$P(TEMP,U,4)
161 I PNAME="" S PNAME=$P(TEMP,U,1)
162 S NAME="Computed Finding: "_PNAME_" = "
163 S IND=0
164 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
165 . S VALUE=$G(IFIEVAL(IND,"VALUE"))
166 . S DATE=IFIEVAL(IND,"DATE")
167 . S TEMP=NAME_VALUE_" ("_$$EDATE^PXRMDATE(DATE)_")"
168 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
169 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
170 S NLINES=NLINES+1,TEXT(NLINES)=""
171 Q
172 ;
173 ;=======================================================
174OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
175 ;maintenance output.
176 N DATA,DATE,FIEN,IND,JND,NOUT,PNAME,TEMP,TEXTOUT,VALUE
177 S FIEN=$P(IFIEVAL("FINDING"),";",1)
178 S TEMP=^PXRMD(811.4,FIEN,0)
179 S PNAME=$P(TEMP,U,4)
180 I PNAME="" S PNAME=$P(TEMP,U,1)
181 S NLINES=NLINES+1
182 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Computed Finding: "_PNAME
183 S IND=0
184 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
185 . S DATE=IFIEVAL(IND,"DATE")
186 . S TEMP=$$EDATE^PXRMDATE(DATE)
187 . S VALUE=$G(IFIEVAL(IND,"VALUE"))
188 . I VALUE'="" S TEMP=TEMP_" value - "_VALUE
189 .;If there is text append it.
190 . I $G(IFIEVAL(IND,"TEXT"))'="" S TEMP=TEMP_"; "_IFIEVAL(IND,"TEXT")
191 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
192 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
193 S NLINES=NLINES+1,TEXT(NLINES)=""
194 Q
195 ;
Note: See TracBrowser for help on using the repository browser.