Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDRUG.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/PXRMDRUG.m
r613 r623 1 PXRMDRUG ; SLC/PKR - Handle drug findings. ;04/23/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;=============================================== 5 DEVAL(DFN,FINDPA,DEFARR,FINDING,RXTYL,DRUG,POI,FIEVAL) ;Evaluate a drug 6 ;finding. 7 I DRUG=0,POI=0 S FIEVAL=0 Q 8 N DTERM,FIEVT 9 ;Create the pseudo term. 10 S DTERM(0)="DTERM",DTERM("IEN")=0 11 I $D(RXTYL("I")),DRUG>0 D 12 . M DTERM(20,1)=DEFARR(20,FINDING) 13 . S $P(DTERM(20,1,0),U,1)=DRUG_";PS(55," 14 . S DTERM("E","PS(55,",DRUG,1)="" 15 I $D(RXTYL("O")),DRUG>0 D 16 . M DTERM(20,3)=DEFARR(20,FINDING) 17 . S $P(DTERM(20,3,0),U,1)=DRUG_";PSRX(" 18 . S DTERM("E","PSRX(",DRUG,3)="" 19 I $D(RXTYL("N")),POI>0 D 20 . M DTERM(20,2)=DEFARR(20,FINDING) 21 . S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA," 22 . S DTERM("E","PS(55NVA,",POI,2)="" 23 K FIEVT 24 D IEVALTER^PXRMTERM(DFN,.FINDPA,.DTERM,1,.FIEVT) 25 M FIEVAL=FIEVT(1) 26 I FIEVAL S FIEVAL("FINDING")=DRUG_";PSDRUG(",FIEVAL("DISPENSE DRUG")=DRUG 27 Q 28 ; 29 ;=============================================== 30 EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate drug findings. 31 N DRUGIEN,DTERM,FIEVT,FINDPA,FINDING 32 N NOINDEX,POI,RXTYL 33 S NOINDEX=0 34 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 35 . D NOINDEX^PXRMERRH("D",PXRMITEM,52) 36 . S NOINDEX=1 37 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 38 . D NOINDEX^PXRMERRH("D",PXRMITEM,55) 39 . S NOINDEX=1 40 S DRUGIEN="" 41 F S DRUGIEN=$O(DEFARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D 42 . ;DBIA #221 43 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 44 . S FINDING="" 45 . F S FINDING=$O(DEFARR("E",ENODE,DRUGIEN,FINDING)) Q:+FINDING=0 D 46 .. I NOINDEX S FIEVAL(FINDING)=0 Q 47 .. M FINDPA=DEFARR(20,FINDING) 48 .. K FIEVT,RXTYL 49 ..;Determine where we search. 50 .. D SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL) 51 .. D DEVAL(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUGIEN,POI,.FIEVT) 52 .. M FIEVAL(FINDING)=FIEVT 53 Q 54 ; 55 ;=============================================== 56 EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate drug terms for 57 ;building patient lists. 58 N BDT,EDT,DATE,DFN,DRUGIEN,ITEM,FILENUM,IND,LIST,NFOUND,NOCC,NOINDEX 59 N PFINDPA,POI,RXTYL,TEMP,TF,TFINDPA,TFINDING,TGLIST,TLIST 60 S NOINDEX=0 61 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 62 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 63 . S NOINDEX=1 64 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 65 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 66 . S NOINDEX=1 67 I NOINDEX Q 68 S TGLIST="EVALPL_PXRMDRUG" 69 K ^TMP($J,TGLIST) 70 S DRUGIEN="" 71 F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D 72 . ;DBIA #221 73 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 74 . S TFINDING="" 75 . F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,TFINDING)) Q:+TFINDING=0 D 76 .. K PFINDPA,TFINDPA 77 .. M TFINDPA=TERMARR(20,TFINDING) 78 ..;Set the finding parameters. 79 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 80 ..;Determine where we search. 81 .. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL) 82 .. I $D(RXTYL("I")) D GPLIST^PXRMINDL(55,"IP",DRUGIEN,.PFINDPA,TGLIST) 83 .. I $D(RXTYL("N")),POI'="" D GPLIST^PXRMINDL("55NVA","IP",POI,.PFINDPA,TGLIST) 84 .. I $D(RXTYL("O")) D GPLIST^PXRMINDL(52,"IP",DRUGIEN,.PFINDPA,TGLIST) 85 ;Return the NOCC most recent results for each DFN. 86 S NOCC=$P(FINDPA(0),U,14) 87 S NOCC=$S(NOCC<0:-NOCC,NOCC="":1,1:NOCC) 88 F TF=0,1 D 89 . S DFN=0 90 . F S DFN=$O(^TMP($J,TGLIST,TF,DFN)) Q:DFN="" D 91 .. K TLIST 92 .. S ITEM="" 93 .. F S ITEM=$O(^TMP($J,TGLIST,TF,DFN,ITEM)) Q:ITEM="" D 94 ... S NFOUND="" 95 ... F S NFOUND=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND)) Q:NFOUND="" D 96 .... S FILENUM="" 97 .... F S FILENUM=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)) Q:FILENUM="" D 98 ..... S TEMP=^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM) 99 ..... S DATE=+$P(TEMP,U,3) 100 ..... S TLIST(TF,DATE,ITEM,NFOUND,FILENUM)="" 101 .. S DATE="",NFOUND=0 102 .. F S DATE=$O(TLIST(TF,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D 103 ... S ITEM="" 104 ... F S ITEM=$O(TLIST(TF,DATE,ITEM)) Q:(ITEM="")!(NFOUND=NOCC) D 105 .... S IND="" 106 .... F S IND=$O(TLIST(TF,DATE,ITEM,IND)) Q:(IND="")!(NFOUND=NOCC) D 107 ..... S FILENUM="" 108 ..... F S FILENUM=$O(TLIST(TF,DATE,ITEM,IND,FILENUM)) Q:(FILENUM="")!(NFOUND=NOCC) D 109 ...... S NFOUND=NFOUND+1 110 ...... S ^TMP($J,PLIST,TF,DFN,ITEM,NFOUND,FILENUM)=^TMP($J,TGLIST,TF,DFN,ITEM,IND,FILENUM) 111 K ^TMP($J,TGLIST) 112 Q 113 ; 114 ;=============================================== 115 EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate drug terms. 116 N DATEORDR,DRUGIEN,DTERM,DTFIEVAL,IND,JND,NOINDEX,PFINDPA,POI 117 N RXTYL,TEMP,TFINDING,TFINDPA 118 N DATEORDR,NOCC,SDIR 119 S NOINDEX=0 120 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 121 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 122 . S NOINDEX=1 123 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 124 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 125 . S NOINDEX=1 126 ;Set NOCC and SDIR. 127 S NOCC=$P(FINDPA(0),U,14) 128 I NOCC="" S NOCC=1 129 S SDIR=$S(NOCC<0:+1,1:-1) 130 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 131 S DRUGIEN="" 132 F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D 133 . ;DBIA #221 134 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 135 . S TFINDING="" 136 . F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,TFINDING)) Q:+TFINDING=0 D 137 .. S TFIEVAL(TFINDING)=0 138 .. I NOINDEX Q 139 .. K DTERM,DTFIEVAL,PFINDPA,TFINDPA 140 .. S DTERM(0)="DTERM",DTERM("IEN")=0 141 .. M TFINDPA=TERMARR(20,TFINDING) 142 ..;Set the finding parameters. 143 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 144 ..;Determine where we search. 145 .. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL) 146 .. I $D(RXTYL("I")) D 147 ... M DTERM(20,1)=TERMARR(20,TFINDING) 148 ... S $P(DTERM(20,1,0),U,1)=DRUGIEN_";PS(55," 149 ... S DTERM("E","PS(55,",DRUGIEN,1)="" 150 .. I $D(RXTYL("N")),POI'="" D 151 ... M DTERM(20,2)=TERMARR(20,TFINDING) 152 ... S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA," 153 ... S DTERM("E","PS(55NVA,",POI,2)="" 154 .. I $D(RXTYL("O")) D 155 ... M DTERM(20,3)=TERMARR(20,TFINDING) 156 ... S $P(DTERM(20,3,0),U,1)=DRUGIEN_";PSRX(" 157 ... S DTERM("E","PSRX(",DRUGIEN,3)="" 158 .. D IEVALTER^PXRMTERM(DFN,.PFINDPA,.DTERM,TFINDING,.DTFIEVAL) 159 .. D DORDER^PXRMTERM(.DTFIEVAL,.DATEORDR) 160 .. D COPY^PXRMTERM(NOCC,SDIR,.DTFIEVAL,.DATEORDR,TFINDING,.TFIEVAL) 161 ..;Save the dispense drug 162 .. S JND=0 163 .. F S JND=+$O(TFIEVAL(TFINDING,JND)) Q:JND=0 S TFIEVAL(TFINDING,JND,"DISPENSE DRUG")=DRUGIEN 164 Q 165 ; 166 ;=============================================== 167 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output. 168 N DRUG,DRUGIEN,IND,FTYPE,NAME,PFIEVAL,TEMP 169 S DRUGIEN=IFIEVAL("DISPENSE DRUG") 170 ;DBIA #10043 171 S DRUG=$P(^PSDRUG(DRUGIEN,0),U,1) 172 S NAME="Drug: "_DRUG_" = " 173 S NLINES=NLINES+1 174 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG 175 S IND=0 176 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D 177 . S TEMP=IFIEVAL(IND,"FINDING") 178 . S FTYPE=$P(TEMP,";",2) 179 . K PFIEVAL M PFIEVAL=IFIEVAL(IND) 180 . S PFIEVAL("DISPENSE DRUG")=DRUG 181 . I FTYPE="PS(55," D MHVOUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 182 . I FTYPE="PS(55NVA," D MHVOUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 183 . I FTYPE="PSRX(" D MHVOUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 184 S NLINES=NLINES+1,TEXT(NLINES)="" 185 Q 186 ; 187 ;=============================================== 188 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical 189 ;maintenance output. 190 N DRUG,FTYPE,IND,PFIEVAL,TEMP,TEXTOUT 191 ;DBIA #10043 192 S DRUG=$P(^PSDRUG(IFIEVAL("DISPENSE DRUG"),0),U,1) 193 S NLINES=NLINES+1 194 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG 195 S IND=0 196 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D 197 . S TEMP=IFIEVAL(IND,"FINDING") 198 . S FTYPE=$P(TEMP,";",2) 199 . K PFIEVAL M PFIEVAL=IFIEVAL(IND) 200 . S PFIEVAL("DISPENSE DRUG")=DRUG 201 . I FTYPE="PS(55," D OUTPUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 202 . I FTYPE="PS(55NVA," D OUTPUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 203 . I FTYPE="PSRX(" D OUTPUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 204 Q 205 ; 1 PXRMDRUG ; SLC/PKR - Handle drug findings. ;06/08/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;=============================================== 5 DEVAL(DFN,FINDPA,DEFARR,FINDING,RXTYL,DRUG,POI,FIEVAL) ;Evaluate a drug 6 ;finding. 7 I DRUG=0,POI=0 S FIEVAL=0 Q 8 N DTERM,FIEVT 9 ;Create the pseudo term. 10 S DTERM(0)="DTERM",DTERM("IEN")=0 11 I $D(RXTYL("I")),DRUG>0 D 12 . M DTERM(20,1)=DEFARR(20,FINDING) 13 . S $P(DTERM(20,1,0),U,1)=DRUG_";PS(55," 14 . S DTERM("E","PS(55,",DRUG,1)="" 15 I $D(RXTYL("O")),DRUG>0 D 16 . M DTERM(20,3)=DEFARR(20,FINDING) 17 . S $P(DTERM(20,3,0),U,1)=DRUG_";PSRX(" 18 . S DTERM("E","PSRX(",DRUG,3)="" 19 I $D(RXTYL("N")),POI>0 D 20 . M DTERM(20,2)=DEFARR(20,FINDING) 21 . S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA," 22 . S DTERM("E","PS(55NVA,",POI,2)="" 23 K FIEVT 24 D IEVALTER^PXRMTERM(DFN,.FINDPA,.DTERM,1,.FIEVT) 25 M FIEVAL=FIEVT(1) 26 I FIEVAL S FIEVAL("FINDING")=DRUG_";PSDRUG(",FIEVAL("DISPENSE DRUG")=DRUG 27 Q 28 ; 29 ;=============================================== 30 EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate drug findings. 31 N DRUGIEN,DTERM,FIEVT,FINDPA,FINDING 32 N NOINDEX,POI,RXTYL 33 S NOINDEX=0 34 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 35 . D NOINDEX^PXRMERRH("D",PXRMITEM,52) 36 . S NOINDEX=1 37 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 38 . D NOINDEX^PXRMERRH("D",PXRMITEM,55) 39 . S NOINDEX=1 40 S DRUGIEN="" 41 F S DRUGIEN=$O(DEFARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D 42 . ;DBIA #221 43 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 44 . S FINDING="" 45 . F S FINDING=$O(DEFARR("E",ENODE,DRUGIEN,FINDING)) Q:+FINDING=0 D 46 .. I NOINDEX S FIEVAL(FINDING)=0 Q 47 .. M FINDPA=DEFARR(20,FINDING) 48 .. K FIEVT,RXTYL 49 ..;Determine where we search. 50 .. D SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL) 51 .. D DEVAL(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUGIEN,POI,.FIEVT) 52 .. M FIEVAL(FINDING)=FIEVT 53 Q 54 ; 55 ;=============================================== 56 EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate drug terms for 57 ;building patient lists. 58 N BDT,EDT,DATE,DFN,DRUGIEN,ITEM,FILENUM,IND,LIST,NFOUND,NOCC,NOINDEX 59 N PFINDPA,POI,RXTYL,TEMP,TF,TFINDPA,TFINDING,TGLIST,TLIST 60 S NOINDEX=0 61 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 62 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 63 . S NOINDEX=1 64 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 65 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 66 . S NOINDEX=1 67 I NOINDEX Q 68 S TGLIST="EVALPL_PXRMDRUG" 69 K ^TMP($J,TGLIST) 70 S DRUGIEN="" 71 F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D 72 . ;DBIA #221 73 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 74 . S TFINDING="" 75 . F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,TFINDING)) Q:+TFINDING=0 D 76 .. K PFINDPA,TFINDPA 77 .. M TFINDPA=TERMARR(20,TFINDING) 78 ..;Set the finding parameters. 79 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 80 ..;Determine where we search. 81 .. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL) 82 .. I $D(RXTYL("I")) D GPLIST^PXRMINDL(55,"IP",DRUGIEN,.PFINDPA,TGLIST) 83 .. I $D(RXTYL("N")),POI'="" D GPLIST^PXRMINDL("55NVA","IP",POI,.PFINDPA,TGLIST) 84 .. I $D(RXTYL("O")) D GPLIST^PXRMINDL(52,"IP",DRUGIEN,.PFINDPA,TGLIST) 85 ;Return the NOCC most recent results for each DFN. 86 S NOCC=$P(FINDPA(0),U,14) 87 S NOCC=$S(NOCC<0:-NOCC,NOCC="":1,1:NOCC) 88 F TF=0,1 D 89 . S DFN=0 90 . F S DFN=$O(^TMP($J,TGLIST,TF,DFN)) Q:DFN="" D 91 .. K TLIST 92 .. S ITEM="" 93 .. F S ITEM=$O(^TMP($J,TGLIST,TF,DFN,ITEM)) Q:ITEM="" D 94 ... S NFOUND="" 95 ... F S NFOUND=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND)) Q:NFOUND="" D 96 .... S FILENUM="" 97 .... F S FILENUM=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)) Q:FILENUM="" D 98 ..... S TEMP=^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM) 99 ..... S DATE=+$P(TEMP,U,3) 100 ..... S TLIST(TF,DATE,ITEM,NFOUND,FILENUM)="" 101 .. S DATE="",NFOUND=0 102 .. F S DATE=$O(TLIST(TF,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D 103 ... S ITEM="" 104 ... F S ITEM=$O(TLIST(TF,DATE,ITEM)) Q:(ITEM="")!(NFOUND=NOCC) D 105 .... S IND="" 106 .... F S IND=$O(TLIST(TF,DATE,ITEM,IND)) Q:(IND="")!(NFOUND=NOCC) D 107 ..... S FILENUM="" 108 ..... F S FILENUM=$O(TLIST(TF,DATE,ITEM,IND,FILENUM)) Q:(FILENUM="")!(NFOUND=NOCC) D 109 ...... S NFOUND=NFOUND+1 110 ...... S ^TMP($J,PLIST,TF,DFN,ITEM,NFOUND,FILENUM)=^TMP($J,TGLIST,TF,DFN,ITEM,IND,FILENUM) 111 K ^TMP($J,TGLIST) 112 Q 113 ; 114 ;=============================================== 115 EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate drug terms. 116 N DATEORDR,DRUGIEN,DTERM,DTFIEVAL,IND,NOINDEX,PFINDPA,POI 117 N RXTYL,TEMP,TFINDING,TFINDPA 118 N DATEORDR,NOCC,SDIR 119 S NOINDEX=0 120 I $G(^PXRMINDX(52,"DATE BUILT"))="" D 121 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52) 122 . S NOINDEX=1 123 I $G(^PXRMINDX(55,"DATE BUILT"))="" D 124 . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55) 125 . S NOINDEX=1 126 ;Set NOCC and SDIR. 127 S NOCC=$P(FINDPA(0),U,14) 128 I NOCC="" S NOCC=1 129 S SDIR=$S(NOCC<0:+1,1:-1) 130 S NOCC=$S(NOCC<0:-NOCC,1:NOCC) 131 S DRUGIEN="" 132 F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D 133 . ;DBIA #221 134 . S POI=$P($G(^PSDRUG(DRUGIEN,2)),U,1) 135 . S TFINDING="" 136 . F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,TFINDING)) Q:+TFINDING=0 D 137 .. S TFIEVAL(TFINDING)=0 138 .. I NOINDEX Q 139 .. K DTERM,DTFIEVAL,PFINDPA,TFINDPA 140 .. S DTERM(0)="DTERM",DTERM("IEN")=0 141 .. M TFINDPA=TERMARR(20,TFINDING) 142 ..;Set the finding parameters. 143 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA) 144 ..;Determine where we search. 145 .. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL) 146 .. I $D(RXTYL("I")) D 147 ... M DTERM(20,1)=TERMARR(20,TFINDING) 148 ... S $P(DTERM(20,1,0),U,1)=DRUGIEN_";PS(55," 149 ... S DTERM("E","PS(55,",DRUGIEN,1)="" 150 .. I $D(RXTYL("N")),POI'="" D 151 ... M DTERM(20,2)=TERMARR(20,TFINDING) 152 ... S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA," 153 ... S DTERM("E","PS(55NVA,",POI,2)="" 154 .. I $D(RXTYL("O")) D 155 ... M DTERM(20,3)=TERMARR(20,TFINDING) 156 ... S $P(DTERM(20,3,0),U,1)=DRUGIEN_";PSRX(" 157 ... S DTERM("E","PSRX(",DRUGIEN,3)="" 158 .. D IEVALTER^PXRMTERM(DFN,.PFINDPA,.DTERM,TFINDING,.DTFIEVAL) 159 .. D DORDER^PXRMTERM(.DTFIEVAL,.DATEORDR) 160 .. D COPY^PXRMTERM(NOCC,SDIR,.DTFIEVAL,.DATEORDR,TFINDING,.TFIEVAL) 161 .. I TFIEVAL(TFINDING) S TFIEVAL(TFINDING,"DISPENSE DRUG")=DRUGIEN 162 Q 163 ; 164 ;=============================================== 165 MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output. 166 N DRUG,DRUGIEN,IND,FTYPE,NAME,PFIEVAL,TEMP 167 S DRUGIEN=IFIEVAL("DISPENSE DRUG") 168 ;DBIA #10043 169 S DRUG=$P(^PSDRUG(DRUGIEN,0),U,1) 170 S NAME="Drug: "_DRUG_" = " 171 S NLINES=NLINES+1 172 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG 173 S IND=0 174 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D 175 . S TEMP=IFIEVAL(IND,"FINDING") 176 . S FTYPE=$P(TEMP,";",2) 177 . K PFIEVAL M PFIEVAL=IFIEVAL(IND) 178 . S PFIEVAL("DISPENSE DRUG")=DRUG 179 . I FTYPE="PS(55," D MHVOUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 180 . I FTYPE="PS(55NVA," D MHVOUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 181 . I FTYPE="PSRX(" D MHVOUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 182 S NLINES=NLINES+1,TEXT(NLINES)="" 183 Q 184 ; 185 ;=============================================== 186 OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical 187 ;maintenance output. 188 N DRUG,FTYPE,IND,PFIEVAL,TEMP,TEXTOUT 189 ;DBIA #10043 190 S DRUG=$P(^PSDRUG(IFIEVAL("DISPENSE DRUG"),0),U,1) 191 S NLINES=NLINES+1 192 S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG 193 S IND=0 194 F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D 195 . S TEMP=IFIEVAL(IND,"FINDING") 196 . S FTYPE=$P(TEMP,";",2) 197 . K PFIEVAL M PFIEVAL=IFIEVAL(IND) 198 . S PFIEVAL("DISPENSE DRUG")=DRUG 199 . I FTYPE="PS(55," D OUTPUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 200 . I FTYPE="PS(55NVA," D OUTPUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 201 . I FTYPE="PSRX(" D OUTPUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q 202 Q 203 ;
Note:
See TracChangeset
for help on using the changeset viewer.
