Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTAX.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/PXRMTAX.m
r613 r623 1 PXRMTAX ; SLC/PKR - Handle taxonomy finding. ;10/11/20072 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 4 5 EVALFI(DFN,DEFARR,ENODE,FIEVAL) 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 EVALPL(FINDPA,ENODE,TERMARR,PLIST) 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 FIEVAL(DFN,TAXIEN,FINDPA,FIEVAL) 54 55 56 57 58 59 60 61 62 63 64 65 66 67 S NGET=$S(UCIFS:50,1:NOCC)68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 GPLIST(TAXIEN,FINDPA,PLIST) 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 1 PXRMTAX ; SLC/PKR - Handle taxonomy finding. ;07/17/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;================================================== 5 EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate taxonomy findings. 6 N FIEVT,FINDPA,FINDING 7 N TAXIEN 8 S TAXIEN="" 9 F S TAXIEN=$O(DEFARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0 D 10 . S FINDING="" 11 . F S FINDING=$O(DEFARR("E",ENODE,TAXIEN,FINDING)) Q:+FINDING=0 D 12 .. K FINDPA 13 .. M FINDPA=DEFARR(20,FINDING) 14 .. K FIEVT 15 .. D FIEVAL(DFN,TAXIEN,.FINDPA,.FIEVT) 16 .. M FIEVAL(FINDING)=FIEVT 17 Q 18 ; 19 ;================================================== 20 EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate taxonomy terms for 21 ;building patient lists. 22 N PFIND3,PFIND4,PFINDPA,TAXIEN 23 N TFINDPA,TFINDING 24 S TAXIEN="" 25 F S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0 D 26 . S TFINDING="" 27 . F S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0 D 28 .. K PFINDPA,TFINDPA 29 .. M TFINDPA=TERMARR(20,TFINDING) 30 ..;Set the finding parameters. 31 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 32 .. D GPLIST(TAXIEN,.PFINDPA,PLIST) 33 Q 34 ; 35 ;================================================== 36 EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate taxonomy 37 ;terms. 38 N FIEVT,PFINDPA 39 N TAXIEN,TFINDPA,TFINDING 40 S TAXIEN="" 41 F S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0 D 42 . S TFINDING="" 43 . F S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0 D 44 .. K FIEVT,PFINDPA,TFINDPA 45 .. M TFINDPA=TERMARR(20,TFINDING) 46 ..;Set the finding parameters. 47 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 48 .. D FIEVAL(DFN,TAXIEN,.PFINDPA,.FIEVT) 49 .. M TFIEVAL(TFINDING)=FIEVT 50 Q 51 ; 52 ;================================================== 53 FIEVAL(DFN,TAXIEN,FINDPA,FIEVAL) ; 54 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,ENS,FIEVT,FILENUM,FLIST 55 N ICOND,IND,INS,INVFD 56 N NFOUND,NGET,NICD0,NICD9,NCPT,NOCC,NP,NRCPT,PLS 57 N RAS,SAVE,SDIR,STATUSA,TAXARR,TLIST,UCIFS,USEINP,VSLIST 58 ;Set the finding search parameters. 59 D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT) 60 S INVFD=$P(FINDPA(0),U,16) 61 D TAX^PXRMLDR(TAXIEN,.TAXARR) 62 I TAXARR(0)["NO LOCK" S FIEVAL(1)=0 Q 63 D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS) 64 D SCPAR^PXRMCOND(.FINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST) 65 S SDIR=$S(NOCC<0:+1,1:-1) 66 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 67 S NGET=$S(UCIFS:"*",1:NOCC) 68 ; 69 I (NICD0>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD0",.TLIST) 70 ; 71 I (NICD9>0),INS D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,"ICD9",.TLIST) 72 I (NICD9>0),ENS D FPDAT^PXRMVPOV(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST) 73 I (NICD9>0),PLS D 74 . K STATUSA 75 . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA) 76 . D FPDAT^PXRMPROB(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.STATUSA,.TLIST) 77 ; 78 I (NCPT>0),(ENS) D FPDAT^PXRMVCPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST) 79 ; 80 I (NRCPT>0),(RAS) D 81 . K STATUSA 82 . D GETSTATI^PXRMSTAT(70,.FINDPA,.STATUSA) 83 . D FPDAT^PXRMRCPT(DFN,.TAXARR,NOCC,BDT,EDT,.STATUSA,.TLIST) 84 ; 85 ;Process the found list, returning the NOCC most recent results. 86 S NFOUND=0 87 S DATE="" 88 F S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCC) D 89 . S IND=0 90 . F S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NOCC) D 91 .. S FILENUM=0 92 .. F S FILENUM=$O(TLIST(DATE,IND,FILENUM)) Q:FILENUM="" D 93 ... S NFOUND=NFOUND+1 94 ... S DAS=$P(TLIST(DATE,IND,FILENUM),U,1) 95 ... S FLIST(NFOUND)=TLIST(DATE,IND,FILENUM) 96 ... S FLIST(NFOUND)=DAS_U_DATE_U_FILENUM_U_$P(TLIST(DATE,IND,FILENUM),U,2,10) 97 I NFOUND=0 S FIEVAL=0 Q 98 S NP=0 99 F IND=1:1:NFOUND Q:NP=NOCC D 100 . S DAS=$P(FLIST(IND),U,1) 101 . S FILENUM=$P(FLIST(IND),U,3) 102 . D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT) 103 . I $D(FIEVT("VISIT")) D GETDATA^PXRMVSIT(FIEVT("VISIT"),.FIEVT,0) 104 . S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVT),1:1) 105 . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0) 106 . I SAVE D 107 .. S NP=NP+1 108 .. S FIEVAL(NP)=CONVAL 109 .. S FIEVAL(NP,"CONDITION")=CONVAL 110 .. S FIEVAL(NP,"CODEP")=$P(FLIST(IND),U,4) 111 .. S FIEVAL(NP,"DAS")=DAS 112 .. S FIEVAL(NP,"DATE")=$P(FLIST(IND),U,2) 113 .. S FIEVAL(NP,"FILE NUMBER")=FILENUM 114 .. S FIEVAL(NP,"FILE SPECIFIC")=$P(FLIST(IND),U,5,10) 115 .. S FIEVAL(NP,"FINDING")=TAXIEN_";PXD(811.2," 116 .. M FIEVAL(NP)=FIEVT 117 .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVT 118 ;Save the finding result. 119 D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL) 120 Q 121 ; 122 ;================================================== 123 GPLIST(TAXIEN,FINDPA,PLIST) ;Get the list of patients with 124 ;taxonomy TAXIEN. Return the list as: 125 ; ^TMP($J,PLIST,T/F,DFN,TAXIEN,COUNT,FILE NUMBER) 126 ; =DAS^DATE^CODE^TYPE^file specific. TAXIEN is like the item for 127 ;non-taxonomy findings. 128 N BDT,COND,DATE,DFN,DLIST,EDT,ENS,FILENUM 129 N ICOND,IND,INS,IPLIST 130 N NF,NFOUND,NICD0,NICD9,NCPT,NF,NGET,NOCC,NRCPT 131 N PLS,RAS,STATUSA,UCIFS,USEINP,TAXARR,TF,TLIST,VSLIST 132 ;Set the finding search parameters. 133 S TLIST="GPLIST_PXRMTAX" 134 K ^TMP($J,TLIST) 135 D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT) 136 D TAX^PXRMLDR(TAXIEN,.TAXARR) 137 D SETVAR^PXRMTAXS(.TAXARR,.ENS,.INS,.NICD0,.NICD9,.NCPT,.NRCPT,.PLS,.RAS) 138 D SCPAR^PXRMCOND(.FINDPA,.COND,.UCIFS,.ICOND,.VSLIST) 139 ; 140 I (NICD0>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD0",TLIST) 141 ; 142 I (NICD9>0),INS D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,"ICD9",TLIST) 143 I (NICD9>0),PLS D 144 . K STATUSA 145 . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA) 146 . D GPLIST^PXRMPROB(.TAXARR,NOCC,BDT,EDT,.STATUSA,TLIST) 147 I (NICD9>0),ENS D GPLIST^PXRMVPOV(.TAXARR,NOCC,BDT,EDT,TLIST) 148 ; 149 I (NCPT>0),ENS D GPLIST^PXRMVCPT(.TAXARR,NOCC,BDT,EDT,TLIST) 150 ; 151 I (NRCPT>0),RAS D GPLIST^PXRMRCPT(.TAXARR,.FINDPA,TLIST) 152 ;Conditions for taxonomies only apply to radiology findings, this 153 ;is taken care of in PXRMRCPT. 154 ;Process the found list, return up to NOCC of the most recent entries. 155 F TF=0,1 D 156 . I '$D(^TMP($J,TLIST,TF)) Q 157 . S DFN="" 158 . F S DFN=$O(^TMP($J,TLIST,TF,DFN)) Q:DFN="" D 159 .. K DLIST,IPLIST 160 .. S NFOUND=0 161 .. S NF="" 162 .. F S NF=$O(^TMP($J,TLIST,TF,DFN,NF),-1) Q:NF="" D 163 ... S FILENUM=0 164 ... F S FILENUM=$O(^TMP($J,TLIST,TF,DFN,NF,FILENUM)) Q:FILENUM="" D 165 .... S NFOUND=NFOUND+1 166 .... S DATE=$P(^TMP($J,TLIST,TF,DFN,NF,FILENUM),U,2) 167 .... S DLIST(DATE,NFOUND)=NF_U_FILENUM 168 ..; 169 .. S DATE="",NFOUND=0 170 .. F S DATE=$O(DLIST(DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D 171 ... S NF=0 172 ... F S NF=$O(DLIST(DATE,NF)) Q:(NF="")!(NFOUND=NOCC) D 173 .... S NFOUND=NFOUND+1 174 .... S IND=$P(DLIST(DATE,NF),U,1) 175 .... S FILENUM=$P(DLIST(DATE,NF),U,2) 176 .... S IPLIST(TF,DFN,TAXIEN,NFOUND,FILENUM)=^TMP($J,TLIST,TF,DFN,IND,FILENUM) 177 .. M ^TMP($J,PLIST)=IPLIST 178 K ^TMP($J,TLIST) 179 Q 180 ; 181 ;================================================== 182 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output. 183 N IND,FILENUM,FNA,OCCLIST,TIFIEVAL 184 S IND=0 185 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)="" 186 S FILENUM="" 187 F S FILENUM=$O(FNA(FILENUM)) Q:FILENUM="" D 188 . K OCCLIST 189 . M OCCLIST=FNA(FILENUM) 190 . I FILENUM=45 D MHVOUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 191 . I FILENUM=70 D MHVOUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 192 . I FILENUM=9000010.07 D MHVOUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 193 . I FILENUM=9000010.18 D MHVOUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 194 . I FILENUM=9000011 D MHVOUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) 195 Q 196 ; 197 ;================================================== 198 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical 199 ;maintenance output. 200 N IND,FILENUM,FNA,OCCLIST,TIFIEVAL 201 S IND=0 202 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)="" 203 S FILENUM="" 204 F S FILENUM=$O(FNA(FILENUM)) Q:FILENUM="" D 205 . K OCCLIST 206 . M OCCLIST=FNA(FILENUM) 207 . I FILENUM=45 D OUTPUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 208 . I FILENUM=70 D OUTPUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 209 . I FILENUM=9000010.07 D OUTPUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 210 . I FILENUM=9000010.18 D OUTPUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q 211 . I FILENUM=9000011 D OUTPUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) 212 Q 213 ;
Note:
See TracChangeset
for help on using the changeset viewer.
