Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMHF.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMHF.m
r613 r623 1 PXRMHF ; SLC/PKR - Handle Health Factor findings. ;06/01/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ;===================================================== 5 CATSORT(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 ;===================================================== 64 EVALFI(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 ;===================================================== 87 EVALPL(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 ;===================================================== 93 EVALTERM(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 ;===================================================== 117 GETDATA(DAS,FIEVT) ;Return data for a specified V Health Factor entry. 118 ;DBIA #4250 119 D VHF^PXPXRM(DAS,.FIEVT) 120 Q 121 ; 122 ;===================================================== 123 MHVOUT(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 ;===================================================== 140 OUTPUT(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 ;===================================================== 166 WARN(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 ; 1 PXRMHF ; SLC/PKR - Handle Health Factor findings. ;12/23/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ;===================================================== 5 CATSORT(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 ;===================================================== 64 EVALFI(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 ;===================================================== 87 EVALPL(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 ;===================================================== 93 EVALTERM(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 ;===================================================== 117 GETDATA(DAS,FIEVT) ;Return data for a specified V Health Factor entry. 118 ;DBIA #4250 119 D VHF^PXPXRM(DAS,.FIEVT) 120 Q 121 ; 122 ;===================================================== 123 MHVOUT(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 ;===================================================== 140 OUTPUT(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 S PNAME=$P(^AUTTHF(FIEN,0),U,1) 145 S NLINES=NLINES+1 146 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Health Factor: "_PNAME 147 S IND=0 148 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D 149 . S VDATE=IFIEVAL(IND,"DATE") 150 . S TEMP=$$EDATE^PXRMDATE(VDATE) 151 . S LVL=$G(IFIEVAL(IND,"VALUE")) 152 . I LVL'="" D 153 .. S TEMP=TEMP_" level/severity - " 154 .. S TEMP=TEMP_$$EXTERNAL^DILFD(9000010.23,.04,"",LVL,.EM) 155 . D FORMATS^PXRMTEXT(INDENT+2,PXRMRM,TEMP,.NOUT,.TEXTOUT) 156 . F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND) 157 . I IFIEVAL(IND,"COMMENTS")'="" D 158 .. S TEMP="Comments: "_IFIEVAL(IND,"COMMENTS") 159 .. D FORMATS^PXRMTEXT(INDENT+3,PXRMRM,TEMP,.NOUT,.TEXTOUT) 160 .. F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND) 161 S NLINES=NLINES+1,TEXT(NLINES)="" 162 Q 163 ; 164 ;===================================================== 165 WARN(HF0) ;Issue a warning if a health factor is missing its category. 166 N XMSUB 167 K ^TMP("PXRMXMZ",$J) 168 S XMSUB="CLINICAL REMINDER DATA PROBLEM, HEALTH FACTOR" 169 S ^TMP("PXRMXMZ",$J,1,0)="Health Factor "_$P(HF0,U,1) 170 S ^TMP("PXRMXMZ",$J,2,0)="does not have a category, this is a required field." 171 S ^TMP("PXRMXMZ",$J,3,0)="This health factor will be ignored for all patients until the problem is fixed." 172 D SEND^PXRMMSG(XMSUB) 173 Q 174 ;
Note:
See TracChangeset
for help on using the changeset viewer.
