Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTERM.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/PXRMTERM.m
r613 r623 1 PXRMTERM ; SLC/PKR - Handle reminder terms. ;04/23/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;============================================= 5 COPY(NOCC,SDIR,TFIEVAL,DATEORDR,FINDING,FIEVAL) ;Copy the NOCC date ordered 6 ;findings from TFIEVAL to FIEVAL(FINDING). 7 N DATE,IND,JND,MRS,NFOUND,TFI 8 ;Start with most recent and go to oldest finding. 9 S MRS=1 10 S NFOUND=0 11 S DATE="" 12 F S DATE=$O(DATEORDR(DATE),SDIR) Q:(NFOUND=NOCC)!(DATE="") D 13 . S TFI=0 14 . F S TFI=$O(DATEORDR(DATE,TFI)) Q:(NFOUND=NOCC)!(TFI="") D 15 .. I MRS D 16 ...;Save the main result node. 17 ... S FIEVAL(FINDING)=TFIEVAL(TFI) 18 ... S MRS=0 19 ... I 'FIEVAL(FINDING) Q 20 ... S JND="@" 21 ... F S JND=$O(TFIEVAL(TFI,JND)) Q:JND="" M FIEVAL(FINDING,JND)=TFIEVAL(TFI,JND) 22 .. I 'FIEVAL(FINDING) Q 23 .. S IND=0 24 .. F S IND=$O(DATEORDR(DATE,TFI,IND)) Q:(NFOUND=NOCC)!(IND="") D 25 ...;Only save true sub-results. 26 ... I 'TFIEVAL(TFI,IND) Q 27 ... S NFOUND=NFOUND+1 28 ... M FIEVAL(FINDING,NFOUND)=TFIEVAL(TFI,IND) 29 ... S FIEVAL(FINDING,NFOUND,"FILE NUMBER")=TFIEVAL(TFI,"FILE NUMBER") 30 ... S FIEVAL(FINDING,NFOUND,"FINDING")=TFIEVAL(TFI,"FINDING") 31 ... S JND=0 32 ... F S JND=$O(TFIEVAL(TFI,IND,JND)) Q:JND="" M FIEVAL(FINDING,NFOUND,JND)=TFIEVAL(TFI,IND,JND) 33 Q 34 ; 35 ;============================================= 36 DORDER(TFIEVAL,DATEORDR) ;Order term findings by date, term finding, 37 ;and term finding occurrence. 38 N DATE,FI,IND 39 K DATEORDR 40 S FI=0 41 F S FI=+$O(TFIEVAL(FI)) Q:FI=0 D 42 . S IND=0 43 . F S IND=+$O(TFIEVAL(FI,IND)) Q:IND=0 D 44 .. S DATE=$G(TFIEVAL(FI,IND,"DATE")) 45 .. I DATE'="" S DATEORDR(DATE,FI,IND)="" 46 Q 47 ; 48 ;============================================= 49 EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate all reminder terms in a 50 ;definition. 51 N CASESEN,CONVAL,DATE,DATEORDR 52 N FIEVT,FINDING,FINDPA,IND,NOCC 53 N SDIR,TFIND3,TFIND4,TERMARR,TERMIEN,TFI,TFIEVAL,UCIFS 54 S TERMIEN="" 55 F S TERMIEN=$O(DEFARR("E",ENODE,TERMIEN)) Q:+TERMIEN=0 D 56 . I '$D(^PXRMD(811.5,TERMIEN,20,"E")) D Q 57 .. S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFI",TERMIEN)="Warning no findings items in reminder term "_$P(^PXRMD(811.5,TERMIEN,0),U,1) 58 .. S FINDING="" 59 .. F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:FINDING="" S FIEVAL(FINDING)=0 60 . D TERM^PXRMLDR(TERMIEN,.TERMARR) 61 . S FINDING="" 62 . F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:+FINDING=0 D 63 .. S FIEVAL(FINDING)=0 64 .. S FIEVAL(FINDING,"TERM")=TERMARR(0) 65 .. S FIEVAL(FINDING,"TERM IEN")=TERMIEN 66 .. K FINDPA,TFIEVAL 67 .. M FINDPA=DEFARR(20,FINDING) 68 .. D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL) 69 .. I $G(PXRMTDEB) M ^TMP("PXRMTDEB",$J,FINDING)=TFIEVAL 70 ..;Set NOCC and SDIR. 71 .. S NOCC=$P(FINDPA(0),U,14) 72 .. I NOCC="" S NOCC=1 73 .. S SDIR=$S(NOCC<0:+1,1:-1) 74 .. S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 75 ..;Order the term findings by date. 76 .. D DORDER(.TFIEVAL,.DATEORDR) 77 .. D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL) 78 Q 79 ; 80 ;============================================= 81 EVALTERM(DFN,FINDPA,TERMARR,TFIEVAL) ;Evaluate all the findings in 82 ;a term. Use the "E" cross-reference just like the finding evaluation. 83 N ENODE 84 S ENODE="" 85 F S ENODE=$O(TERMARR("E",ENODE)) Q:ENODE="" D 86 . I ENODE="AUTTEDT(" D EVALTERM^PXRMEDU(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 87 . I ENODE="AUTTEXAM(" D EVALTERM^PXRMEXAM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 88 . I ENODE="AUTTHF(" D EVALTERM^PXRMHF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 89 . I ENODE="AUTTIMM(" D EVALTERM^PXRMIMM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 90 . I ENODE="AUTTSK(" D EVALTERM^PXRMSKIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 91 . I ENODE="GMRD(120.51," D EVALTERM^PXRMVITL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 92 . I ENODE="LAB(60," D EVALTERM^PXRMLAB(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 93 . I ENODE="ORD(101.43," D EVALTERM^PXRMORDR(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 94 . I ENODE="PXD(811.2," D EVALTERM^PXRMTAX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 95 . I ENODE="PXRMD(810.9," D EVALTERM^PXRMLOCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 96 . I ENODE="PXRMD(811.4," D EVALTERM^PXRMCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 97 . I ENODE="PS(50.605," D EVALTERM^PXRMDRCL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 98 . I ENODE="PS(55," D EVALTERM^PXRMDIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 99 . I ENODE="PS(55NVA," D EVALTERM^PXRMDNVA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 100 . I ENODE="PSDRUG(" D EVALTERM^PXRMDRUG(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 101 . I ENODE="PSRX(" D EVALTERM^PXRMDOUT(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 102 . I ENODE="PSNDF(50.6," D EVALTERM^PXRMDGEN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 103 . I ENODE="RAMIS(71," D EVALTERM^PXRMRAD(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 104 . I ENODE="YTT(601.71," D EVALTERM^PXRMMH(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 105 Q 106 ; 107 ;============================================= 108 IEVALTER(DFN,FINDPA,TERMARR,FINDING,FIEVAL) ;Evaluate an individual term 109 ;put the result in FIEVAL(FINDING). 110 N DATEORDR,NOCC,SDIR,TFIEVAL 111 I $D(PXRMPDEM) G DEMOK 112 N PXRMPDEM D DEM^PXRMPINF(DFN,DT,.PXRMPDEM) 113 ;Create the local demographic variables for use in Condition. 114 N PXRMAGE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX 115 S PXRMAGE=PXRMPDEM("AGE"),PXRMDOB=PXRMPDEM("DOB"),PXRMDOD=PXRMPDEM("DOD") 116 S PXRMLAD=PXRMPDEM("LAD"),PXRMSEX=PXRMPDEM("SEX") 117 DEMOK S FIEVAL(FINDING)=0 118 D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL) 119 ;Set NOCC and SDIR. 120 S NOCC=$P(FINDPA(0),U,14) 121 I NOCC="" S NOCC=1 122 S SDIR=$S(NOCC<0:+1,1:-1) 123 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 124 ;Order the term findings by date. 125 D DORDER(.TFIEVAL,.DATEORDR) 126 D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL) 127 Q 128 ; 129 ;============================================= 130 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output. 131 D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"MHV") 132 Q 133 ; 134 ;============================================= 135 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical 136 ;maintenance output. 137 D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"CM") 138 Q 139 ; 140 ;============================================= 141 OPT(INDENT,IFIEVAL,NLINES,TEXT,TYPE) ;General output. 142 N DG,DGL,DGN,IEN,IND,JND,KND,INDENTT,FILENUM,TEMP,TIFIEVAL 143 ;Build the display grouping. 144 S FILENUM=IFIEVAL(1,"FILE NUMBER") 145 S IEN=$P(IFIEVAL(1,"FINDING"),";",1) 146 S DG(FILENUM,IEN)=1,DGL(1)=FILENUM_U_IEN,DGL(1,1)="" 147 S (DGN,IND)=1 148 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D 149 . S FILENUM=IFIEVAL(IND,"FILE NUMBER") 150 . S IEN=$P(IFIEVAL(IND,"FINDING"),";",1) 151 . I '$D(DG(FILENUM,IEN)) D 152 .. S DGN=DGN+1,DG(FILENUM,IEN)=DGN 153 .. S DGL(DGN)=FILENUM_U_IEN,DGL(DGN,IND)="" 154 . I $D(DG(FILENUM,IEN)) D 155 .. S TEMP=DG(FILENUM,IEN),DGL(TEMP,IND)="" 156 S INDENTT=INDENT+1 157 S TEMP=$$INSCHR^PXRMEXLC(INDENT," ")_"Reminder Term: "_$P(FIEVAL(FINDING,"TERM"),U,1) 158 S NLINES=NLINES+1,TEXT(NLINES)=TEMP 159 F IND=1:1:DGN D 160 . K TIFIEVAL 161 . S (JND,KND)=0 162 . F S JND=$O(DGL(IND,JND)) Q:JND="" D 163 .. S KND=KND+1 164 .. I KND=1 M TIFIEVAL=IFIEVAL(JND) 165 .. M TIFIEVAL(KND)=IFIEVAL(JND) 166 . I TYPE="CM" D FOUT^PXRMOUTC(INDENTT,.TIFIEVAL,.NLINES,.TEXT) 167 . I TYPE="MHV" D FOUT^PXRMOUTM(INDENTT,.TIFIEVAL,.NLINES,.TEXT) 168 Q 169 ; 170 ;============================================= 171 SPFINDPA(FINDPA,TFINDPA,PFINDPA) ;Set the finding parameter array 172 ;for terms. 173 N FIND0,PIECE,PFIND0,TFIND0,VAL 174 S FIND0=$G(FINDPA(0)) 175 S (PFIND0,TFIND0)=TFINDPA(0) 176 ;Set the 0 node. 177 F PIECE=9,10,12,13,14,15,16 D 178 . S VAL=$P(TFIND0,U,PIECE) 179 . I VAL="" S VAL=$P(FIND0,U,PIECE) 180 . S $P(PFIND0,U,PIECE)=VAL 181 ;BDT and EDT are treated as a pair. 182 I $P(TFIND0,U,8)="",$P(TFIND0,U,11)="" F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(FIND0,U,PIECE) 183 E F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(TFIND0,U,PIECE) 184 S PFINDPA(0)=PFIND0 185 I $P($G(TFINDPA(3)),U,1)'="" S PFINDPA(3)=TFINDPA(3),PFINDPA(10)=TFINDPA(10),PFINDPA(11)=TFINDPA(11) 186 E S PFINDPA(3)=$G(FINDPA(3)),PFINDPA(10)=$G(FINDPA(10)),PFINDPA(11)=$G(FINDPA(11)) 187 ;Get the status list. 188 I $D(TFINDPA(5)) M PFINDPA(5)=TFINDPA(5) 189 E M PFINDPA(5)=FINDPA(5) 190 I $D(TFINDPA(15)) S PFINDPA(15)=TFINDPA(15) 191 E S PFINDPA(15)=$G(FINDPA(15)) 192 Q 193 ; 1 PXRMTERM ; SLC/PKR - Handle reminder terms. ;06/29/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;============================================= 5 COPY(NOCC,SDIR,TFIEVAL,DATEORDR,FINDING,FIEVAL) ;Copy the NOCC date ordered 6 ;findings from TFIEVAL to FIEVAL(FINDING). 7 N DATE,IND,JND,MRS,NFOUND,TFI 8 ;Start with most recent and go to oldest finding. 9 S MRS=1 10 S NFOUND=0 11 S DATE="" 12 F S DATE=$O(DATEORDR(DATE),SDIR) Q:(NFOUND=NOCC)!(DATE="") D 13 . S TFI=0 14 . F S TFI=$O(DATEORDR(DATE,TFI)) Q:(NFOUND=NOCC)!(TFI="") D 15 .. I MRS D 16 ...;Save the main result node. 17 ... S FIEVAL(FINDING)=TFIEVAL(TFI) 18 ... S MRS=0 19 ... I 'FIEVAL(FINDING) Q 20 ... S JND="@" 21 ... F S JND=$O(TFIEVAL(TFI,JND)) Q:JND="" D 22 .... M FIEVAL(FINDING,JND)=TFIEVAL(TFI,JND) 23 .. I 'FIEVAL(FINDING) Q 24 .. S IND=0 25 .. F S IND=$O(DATEORDR(DATE,TFI,IND)) Q:(NFOUND=NOCC)!(IND="") D 26 ...;Only save true sub-results. 27 ... I 'TFIEVAL(TFI,IND) Q 28 ... S NFOUND=NFOUND+1 29 ... M FIEVAL(FINDING,NFOUND)=TFIEVAL(TFI,IND) 30 ... S FIEVAL(FINDING,NFOUND,"FILE NUMBER")=TFIEVAL(TFI,"FILE NUMBER") 31 ... S FIEVAL(FINDING,NFOUND,"FINDING")=TFIEVAL(TFI,"FINDING") 32 ... S JND=0 33 ... F S JND=$O(TFIEVAL(TFI,IND,JND)) Q:JND="" M FIEVAL(FINDING,NFOUND,JND)=TFIEVAL(TFI,IND,JND) 34 Q 35 ; 36 ;============================================= 37 DORDER(TFIEVAL,DATEORDR) ;Order term findings by date, term finding, 38 ;and term finding occurrence. 39 N DATE,FI,IND 40 K DATEORDR 41 S FI=0 42 F S FI=+$O(TFIEVAL(FI)) Q:FI=0 D 43 . S IND=0 44 . F S IND=+$O(TFIEVAL(FI,IND)) Q:IND=0 D 45 .. S DATE=$G(TFIEVAL(FI,IND,"DATE")) 46 .. I DATE'="" S DATEORDR(DATE,FI,IND)="" 47 Q 48 ; 49 ;============================================= 50 EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate all reminder terms in a 51 ;definition. 52 N CASESEN,CONVAL,DATE,DATEORDR 53 N FIEVT,FINDING,FINDPA,IND,NOCC 54 N SDIR,TFIND3,TFIND4,TERMARR,TERMIEN,TFI,TFIEVAL,UCIFS 55 S TERMIEN="" 56 F S TERMIEN=$O(DEFARR("E",ENODE,TERMIEN)) Q:+TERMIEN=0 D 57 . I '$D(^PXRMD(811.5,TERMIEN,20,"E")) D Q 58 .. S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","NOFI",TERMIEN)="Warning no findings items in reminder term "_$P(^PXRMD(811.5,TERMIEN,0),U,1) 59 .. S FINDING="" 60 .. F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:FINDING="" S FIEVAL(FINDING)=0 61 . D TERM^PXRMLDR(TERMIEN,.TERMARR) 62 . S FINDING="" 63 . F S FINDING=$O(DEFARR("E",ENODE,TERMIEN,FINDING)) Q:+FINDING=0 D 64 .. S FIEVAL(FINDING)=0 65 .. S FIEVAL(FINDING,"TERM")=TERMARR(0) 66 .. S FIEVAL(FINDING,"TERM IEN")=TERMIEN 67 .. K FINDPA,TFIEVAL 68 .. M FINDPA=DEFARR(20,FINDING) 69 .. D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL) 70 .. I $G(PXRMTDEB) M ^TMP("PXRMTDEB",$J,FINDING)=TFIEVAL 71 ..;Set NOCC and SDIR. 72 .. S NOCC=$P(FINDPA(0),U,14) 73 .. I NOCC="" S NOCC=1 74 .. S SDIR=$S(NOCC<0:+1,1:-1) 75 .. S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 76 ..;Order the term findings by date. 77 .. D DORDER(.TFIEVAL,.DATEORDR) 78 .. D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL) 79 Q 80 ; 81 ;============================================= 82 EVALPL(FINDPA,TERMARR,PLIST) ;Build a list of patients based on a 83 ;term. The list is returned in: 84 ;^TMP($J,PLIST,T/F,DFN,ITEM,NFOUND,FILENUM)=DAS_U_DATE_U_VALUE 85 ;for findings with a start and stop date the list is 86 ;^TMP($J,PLIST,T/F,DFN,ITEM,NFOUND,FILENUM)=DAS_U_START_U_STOP_U_VALUE 87 N ENODE 88 K ^TMP($J,PLIST) 89 S ENODE="" 90 F S ENODE=$O(TERMARR("E",ENODE)) Q:ENODE="" D 91 . I ENODE="AUTTEDT(" D EVALPL^PXRMEDU(.FINDPA,ENODE,.TERMARR,PLIST) Q 92 . I ENODE="AUTTEXAM(" D EVALPL^PXRMEXAM(.FINDPA,ENODE,.TERMARR,PLIST) Q 93 . I ENODE="AUTTHF(" D EVALPL^PXRMHF(.FINDPA,ENODE,.TERMARR,PLIST) Q 94 . I ENODE="AUTTIMM(" D EVALPL^PXRMIMM(.FINDPA,ENODE,.TERMARR,PLIST) Q 95 . I ENODE="AUTTSK(" D EVALPL^PXRMSKIN(.FINDPA,ENODE,.TERMARR,PLIST) Q 96 . I ENODE="GMRD(120.51," D EVALPL^PXRMVITL(.FINDPA,ENODE,.TERMARR,PLIST) Q 97 . I ENODE="LAB(60," D EVALPL^PXRMLAB(.FINDPA,ENODE,.TERMARR,PLIST) Q 98 . I ENODE="ORD(101.43," D EVALPL^PXRMORDR(.FINDPA,ENODE,.TERMARR,PLIST) Q 99 . I ENODE="PXRMD(810.9," D EVALPL^PXRMLOCL(.FINDPA,ENODE,.TERMARR,PLIST) Q 100 . I ENODE="PXD(811.2," D EVALPL^PXRMTAX(.FINDPA,ENODE,.TERMARR,PLIST) Q 101 . I ENODE="PXRMD(811.4," D EVALPL^PXRMCF(.FINDPA,ENODE,.TERMARR,PLIST) Q 102 . I ENODE="PS(50.605," D EVALPL^PXRMDRCL(.FINDPA,ENODE,.TERMARR,PLIST) Q 103 . I ENODE="PSDRUG(" D EVALPL^PXRMDRUG(.FINDPA,ENODE,.TERMARR,PLIST) Q 104 . I ENODE="PSNDF(50.6," D EVALPL^PXRMDGEN(.FINDPA,ENODE,.TERMARR,PLIST) Q 105 . I ENODE="RAMIS(71," D EVALPL^PXRMRAD(.FINDPA,ENODE,.TERMARR,PLIST) Q 106 . I ENODE="YTT(601," D EVALPL^PXRMMH(.FINDPA,ENODE,.TERMARR,PLIST) Q 107 Q 108 ; 109 ;============================================= 110 EVALTERM(DFN,FINDPA,TERMARR,TFIEVAL) ;Evaluate all the findings in 111 ;a term. Use the "E" cross-reference just like the finding evaluation. 112 N ENODE 113 S ENODE="" 114 F S ENODE=$O(TERMARR("E",ENODE)) Q:ENODE="" D 115 . I ENODE="AUTTEDT(" D EVALTERM^PXRMEDU(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 116 . I ENODE="AUTTEXAM(" D EVALTERM^PXRMEXAM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 117 . I ENODE="AUTTHF(" D EVALTERM^PXRMHF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 118 . I ENODE="AUTTIMM(" D EVALTERM^PXRMIMM(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 119 . I ENODE="AUTTSK(" D EVALTERM^PXRMSKIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 120 . I ENODE="GMRD(120.51," D EVALTERM^PXRMVITL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 121 . I ENODE="LAB(60," D EVALTERM^PXRMLAB(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 122 . I ENODE="ORD(101.43," D EVALTERM^PXRMORDR(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 123 . I ENODE="PXD(811.2," D EVALTERM^PXRMTAX(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 124 . I ENODE="PXRMD(810.9," D EVALTERM^PXRMLOCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 125 . I ENODE="PXRMD(811.4," D EVALTERM^PXRMCF(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 126 . I ENODE="PS(50.605," D EVALTERM^PXRMDRCL(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 127 . I ENODE="PS(55," D EVALTERM^PXRMDIN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 128 . I ENODE="PS(55NVA," D EVALTERM^PXRMDNVA(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 129 . I ENODE="PSDRUG(" D EVALTERM^PXRMDRUG(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 130 . I ENODE="PSRX(" D EVALTERM^PXRMDOUT(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 131 . I ENODE="PSNDF(50.6," D EVALTERM^PXRMDGEN(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 132 . I ENODE="RAMIS(71," D EVALTERM^PXRMRAD(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 133 . I ENODE="YTT(601," D EVALTERM^PXRMMH(DFN,.FINDPA,ENODE,.TERMARR,.TFIEVAL) Q 134 Q 135 ; 136 ;============================================= 137 IEVALTER(DFN,FINDPA,TERMARR,FINDING,FIEVAL) ;Evaluate an individual term 138 ;put the result in FIEVAL(FINDING). 139 N DATEORDR,NOCC,SDIR,TFIEVAL 140 I $D(PXRMPDEM) G DEMOK 141 N PXRMPDEM D DEM^PXRMPINF(DFN,DT,.PXRMPDEM) 142 ;Create the local demographic variables for use in Condition. 143 N PXRMAGE,PXRMDOB,PXRMDOD,PXRMLAD,PXRMSEX 144 S PXRMAGE=PXRMPDEM("AGE"),PXRMDOB=PXRMPDEM("DOB"),PXRMDOD=PXRMPDEM("DOD") 145 S PXRMLAD=PXRMPDEM("LAD"),PXRMSEX=PXRMPDEM("SEX") 146 DEMOK S FIEVAL(FINDING)=0 147 D EVALTERM(DFN,.FINDPA,.TERMARR,.TFIEVAL) 148 ;Set NOCC and SDIR. 149 S NOCC=$P(FINDPA(0),U,14) 150 I NOCC="" S NOCC=1 151 S SDIR=$S(NOCC<0:+1,1:-1) 152 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 153 ;Order the term findings by date. 154 D DORDER(.TFIEVAL,.DATEORDR) 155 D COPY(NOCC,SDIR,.TFIEVAL,.DATEORDR,FINDING,.FIEVAL) 156 Q 157 ; 158 ;============================================= 159 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output. 160 D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"MHV") 161 Q 162 ; 163 ;============================================= 164 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical 165 ;maintenance output. 166 D OPT(INDENT,.IFIEVAL,.NLINES,.TEXT,"CM") 167 Q 168 ; 169 ;============================================= 170 OPT(INDENT,IFIEVAL,NLINES,TEXT,TYPE) ;General output. 171 N DG,DGL,DGN,DRUG,IEN,IND,JND,KND,INDENTT,FILENUM,TEMP,TIFIEVAL 172 ;If there is a drug make it available for display. 173 S DRUG=$S($D(IFIEVAL("DISPENSE DRUG")):IFIEVAL("DISPENSE DRUG"),1:"") 174 ;DBIA #10043 175 I DRUG'="" S DRUG=$P(^PSDRUG(DRUG,0),U,1) 176 ;Build the display grouping. 177 S FILENUM=IFIEVAL(1,"FILE NUMBER") 178 S IEN=$P(IFIEVAL(1,"FINDING"),";",1) 179 S DG(FILENUM,IEN)=1,DGL(1)=FILENUM_U_IEN,DGL(1,1)="" 180 S (DGN,IND)=1 181 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D 182 . S FILENUM=IFIEVAL(IND,"FILE NUMBER") 183 . S IEN=$P(IFIEVAL(IND,"FINDING"),";",1) 184 . I '$D(DG(FILENUM,IEN)) D 185 .. S DGN=DGN+1,DG(FILENUM,IEN)=DGN 186 .. S DGL(DGN)=FILENUM_U_IEN,DGL(DGN,IND)="" 187 . I $D(DG(FILENUM,IEN)) D 188 .. S TEMP=DG(FILENUM,IEN),DGL(TEMP,IND)="" 189 S INDENTT=INDENT+1 190 S TEMP=$$INSCHR^PXRMEXLC(INDENT," ")_"Reminder Term: "_$P(FIEVAL(FINDING,"TERM"),U,1) 191 S NLINES=NLINES+1,TEXT(NLINES)=TEMP 192 F IND=1:1:DGN D 193 . K TIFIEVAL 194 . S (JND,KND)=0 195 . F S JND=$O(DGL(IND,JND)) Q:JND="" D 196 .. S KND=KND+1 197 .. I KND=1 M TIFIEVAL=IFIEVAL(JND) 198 .. M TIFIEVAL(KND)=IFIEVAL(JND) 199 .. I DRUG'="" S TIFIEVAL("DISPENSE DRUG")=DRUG 200 . I TYPE="CM" D FOUT^PXRMOUTC(INDENTT,.TIFIEVAL,.NLINES,.TEXT) 201 . I TYPE="MHV" D FOUT^PXRMOUTM(INDENTT,.TIFIEVAL,.NLINES,.TEXT) 202 Q 203 ; 204 ;============================================= 205 SPFINDPA(FINDPA,TFINDPA,PFINDPA) ;Set the finding parameter array 206 ;for terms. 207 N FIND0,PIECE,PFIND0,TFIND0,VAL 208 S FIND0=$G(FINDPA(0)) 209 S (PFIND0,TFIND0)=TFINDPA(0) 210 ;Set the 0 node. 211 F PIECE=9,10,12,13,14,15,16 D 212 . S VAL=$P(TFIND0,U,PIECE) 213 . I VAL="" S VAL=$P(FIND0,U,PIECE) 214 . S $P(PFIND0,U,PIECE)=VAL 215 ;BDT and EDT are treated as a pair. 216 I $P(TFIND0,U,8)="",$P(TFIND0,U,11)="" F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(FIND0,U,PIECE) 217 E F PIECE=8,11 S $P(PFIND0,U,PIECE)=$P(TFIND0,U,PIECE) 218 S PFINDPA(0)=PFIND0 219 I $P($G(TFINDPA(3)),U,1)'="" S PFINDPA(3)=TFINDPA(3),PFINDPA(10)=TFINDPA(10),PFINDPA(11)=TFINDPA(11) 220 E S PFINDPA(3)=$G(FINDPA(3)),PFINDPA(10)=$G(FINDPA(10)),PFINDPA(11)=$G(FINDPA(11)) 221 ;Get the status list. 222 I $D(TFINDPA(5)) M PFINDPA(5)=TFINDPA(5) 223 E M PFINDPA(5)=FINDPA(5) 224 I $D(TFINDPA(15)) S PFINDPA(15)=TFINDPA(15) 225 E S PFINDPA(15)=$G(FINDPA(15)) 226 Q 227 ;
Note:
See TracChangeset
for help on using the changeset viewer.
