source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMHF.m

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

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1PXRMHF ; SLC/PKR - Handle Health Factor findings. ;06/01/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;=====================================================
5CATSORT(FIEVAL,FIND0,FARR) ;Sort all the true health factor findings
6 ;according to the category criteria. FIND0 will be defined only
7 ;for terms.
8 N CAT,CATLIST,DATE,IND,FI,HFIEN,LDATE,NTRUE,WCR
9 S HFIEN=""
10 F S HFIEN=$O(FARR("E","AUTTHF(",HFIEN)) Q:HFIEN="" D
11 . S FI=0
12 . F S FI=$O(FARR("E","AUTTHF(",HFIEN,FI)) Q:FI="" D
13 .. I 'FIEVAL(FI) Q
14 ..;Get the Within Category Rank
15 .. S WCR=$P(FARR(20,FI,0),U,10)
16 .. I WCR="" S WCR=$P(FIND0,U,10)
17 .. I WCR="" S WCR=9999
18 ..;If Within Category Rank is 0 ignore the category and treat it like
19 ..;regular finding (exclude it from the list).
20 .. I WCR>0 D
21 ... S CAT=$P(^AUTTHF(HFIEN,0),U,3)
22 ...;If the category is null then send a warning.
23 ... I CAT="" D WARN(^AUTTHF(HFIEN,0)) Q
24 ... S CATLIST(CAT,FIEVAL(FI,"DATE"),WCR,FI)=""
25 ... I $G(PXRMDEBG) S FIEVAL(FI,"CAT^WCR")=CAT_U_WCR
26 ;No health factors to categorize then quit.
27 I '$D(CATLIST) Q
28 ;Only the most recent HF in a category can be true.
29 S CAT=""
30 F S CAT=$O(CATLIST(CAT)) Q:CAT="" D
31 . S LDATE=$O(CATLIST(CAT,""),-1)
32 .;For each category set all but the most recent HF false.
33 . S DATE=""
34 . F S DATE=$O(CATLIST(CAT,DATE)) Q:DATE=LDATE D
35 .. S WCR=""
36 .. F S WCR=$O(CATLIST(CAT,DATE,WCR)) Q:WCR="" D
37 ... S FI=""
38 ... F S FI=$O(CATLIST(CAT,DATE,WCR,FI)) Q:FI="" D
39 .... S FIEVAL(FI)=0
40 ....;If there are multiple occurrences set them all false.
41 .... S IND=0
42 .... F S IND=+$O(FIEVAL(FI,IND)) Q:IND=0 S FIEVAL(FI,IND)=0
43 .;
44 .;If there is more than on HF on the most recent date then only the
45 .;one with the highest WCR can be true. The highest possible WCR is 1.
46 .;Set all with lower WCRs false.
47 .;If the most recent health factor has multiple occurrences only
48 .;the first occurrence can be true.
49 . S (NTRUE,WCR)=0
50 . F S WCR=$O(CATLIST(CAT,LDATE,WCR)) Q:WCR="" D
51 .. S FI=""
52 .. F S FI=$O(CATLIST(CAT,LDATE,WCR,FI)) Q:FI="" D
53 ... I NTRUE=0 D Q
54 ....;If there are multiple sub-occurrences set them all false.
55 .... S (IND,NTRUE)=1
56 .... F S IND=+$O(FIEVAL(FI,IND)) Q:IND=0 S FIEVAL(FI,IND)=0
57 ... S FIEVAL(FI)=0
58 ...;If there are multiple sub-occurrences set them all false.
59 ... S IND=0
60 ... F S IND=+$O(FIEVAL(FI,IND)) Q:IND=0 S FIEVAL(FI,IND)=0
61 Q
62 ;
63 ;=====================================================
64EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate health factor findings.
65 N FIEVT,FILENUM,FINDPA,FINDING,HFIEN,NOINDEX
66 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
67 I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D
68 . D NOINDEX^PXRMERRH("D",PXRMITEM,FILENUM)
69 . S NOINDEX=1
70 E S NOINDEX=0
71 S HFIEN=""
72 F S HFIEN=$O(DEFARR("E",ENODE,HFIEN)) Q:+HFIEN=0 D
73 . S FINDING=""
74 . F S FINDING=$O(DEFARR("E",ENODE,HFIEN,FINDING)) Q:+FINDING=0 D
75 .. I NOINDEX S FIEVAL(FINDING)=0 Q
76 .. K FINDPA
77 .. M FINDPA=DEFARR(20,FINDING)
78 .. K FIEVT
79 .. D FIEVAL^PXRMINDX(FILENUM,"PI",DFN,HFIEN,.FINDPA,.FIEVT)
80 .. M FIEVAL(FINDING)=FIEVT
81 .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
82 ;Sort all the true true findings by category.
83 D CATSORT(.FIEVAL,"",.DEFARR)
84 Q
85 ;
86 ;=====================================================
87EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate health factor term findings
88 ;for patient lists.
89 D EVALPL^PXRMINDL(.FINDPA,ENODE,.TERMARR,PLIST)
90 Q
91 ;
92 ;=====================================================
93EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate health factor terms.
94 N BDT,EDT,FIEVT,HFIEN,NOINDEX,PFINDPA
95 N TFINDPA,TFINDING
96 I $G(^PXRMINDX(9000010.23,"DATE BUILT"))="" D
97 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),9000010.23)
98 . S NOINDEX=1
99 E S NOINDEX=0
100 S HFIEN=""
101 F S HFIEN=$O(TERMARR("E",ENODE,HFIEN)) Q:+HFIEN=0 D
102 . S TFINDING=""
103 . F S TFINDING=$O(TERMARR("E",ENODE,HFIEN,TFINDING)) Q:+TFINDING=0 D
104 .. I NOINDEX S TFIEVAL(TFINDING)=0 Q
105 .. K FIEVT,PFINDPA,TFINDPA
106 .. M TFINDPA=TERMARR(20,TFINDING)
107 ..;Set the finding parameters.
108 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
109 .. D FIEVAL^PXRMINDX(9000010.23,"PI",DFN,HFIEN,.PFINDPA,.FIEVT)
110 .. M TFIEVAL(TFINDING)=FIEVT
111 .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
112 ;Sort all the true true findings by category.
113 D CATSORT(.TFIEVAL,FINDPA(0),.TERMARR)
114 Q
115 ;
116 ;=====================================================
117GETDATA(DAS,FIEVT) ;Return data for a specified V Health Factor entry.
118 ;DBIA #4250
119 D VHF^PXPXRM(DAS,.FIEVT)
120 Q
121 ;
122 ;=====================================================
123MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
124 N EM,FIEN,IND,JND,LVL,NAME,NOUT,PNAME,TEMP,TEXTOUT,VDATE
125 S FIEN=$P(IFIEVAL("FINDING"),";",1)
126 S PNAME=$P(^AUTTHF(FIEN,0),U,1)
127 S NAME="Health Factor: "_PNAME_" = "
128 S IND=0
129 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
130 . S LVL=$G(IFIEVAL(IND,"VALUE"))
131 . I LVL'="" S LVL=$$EXTERNAL^DILFD(9000010.23,.04,"",LVL,.EM)
132 . S VDATE=IFIEVAL(IND,"DATE")
133 . S TEMP=NAME_LVL_" ("_$$EDATE^PXRMDATE(VDATE)_")"
134 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
135 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
136 S NLINES=NLINES+1,TEXT(NLINES)=""
137 Q
138 ;
139 ;=====================================================
140OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
141 ;maintenance output.
142 N EM,FIEN,IND,JND,LVL,NOUT,PNAME,TEMP,TEXTOUT,VDATE
143 S FIEN=$P(IFIEVAL("FINDING"),";",1)
144 ;DBIA #3083
145 S PNAME=$P(^AUTTHF(FIEN,0),U,1)
146 S NLINES=NLINES+1
147 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Health Factor: "_PNAME
148 S IND=0
149 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
150 . S VDATE=IFIEVAL(IND,"DATE")
151 . S TEMP=$$EDATE^PXRMDATE(VDATE)
152 . S LVL=$G(IFIEVAL(IND,"VALUE"))
153 . I LVL'="" D
154 .. S TEMP=TEMP_" level/severity - "
155 .. S TEMP=TEMP_$$EXTERNAL^DILFD(9000010.23,.04,"",LVL,.EM)
156 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT)
157 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
158 . I IFIEVAL(IND,"COMMENTS")'="" D
159 .. S TEMP="Comments: "_IFIEVAL(IND,"COMMENTS")
160 .. D FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT)
161 .. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
162 S NLINES=NLINES+1,TEXT(NLINES)=""
163 Q
164 ;
165 ;=====================================================
166WARN(HF0) ;Issue a warning if a health factor is missing its category.
167 N XMSUB
168 K ^TMP("PXRMXMZ",$J)
169 S XMSUB="CLINICAL REMINDER DATA PROBLEM, HEALTH FACTOR"
170 S ^TMP("PXRMXMZ",$J,1,0)="Health Factor "_$P(HF0,U,1)
171 S ^TMP("PXRMXMZ",$J,2,0)="does not have a category, this is a required field."
172 S ^TMP("PXRMXMZ",$J,3,0)="This health factor will be ignored for all patients until the problem is fixed."
173 D SEND^PXRMMSG(XMSUB)
174 Q
175 ;
Note: See TracBrowser for help on using the repository browser.