source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDRUG.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 7.3 KB
Line 
1PXRMDRUG ; SLC/PKR - Handle drug findings. ;04/23/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;===============================================
5DEVAL(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 ;===============================================
30EVALFI(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 ;===============================================
56EVALPL(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 ;===============================================
115EVALTERM(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 ;===============================================
167MHVOUT(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 ;===============================================
188OUTPUT(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 ;
Note: See TracBrowser for help on using the repository browser.