source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPMP0.m@ 1042

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

revised back to 6/30/08 version

File size: 9.2 KB
Line 
1PSOPMP0 ;BIRM/MFR - Patient Medication Profile - Listmanager ;10/28/06
2 ;;7.0;OUTPATIENT PHARMACY;**260**;DEC 1997;Build 84
3 ;Reference to EN1^GMRADPT supported by IA #10099
4 ;Reference to EN6^GMRVUTL supported by IA #1120
5 ;Reference to ^PS(55 supported by DBIA 2228
6 ;
7EN ; - Menu option entry point
8 N PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSIGDP,PSOSTSGP,PSOSTORD,PSORDCNT,PSOSTSEQ,PSORDSEQ,PSOCHNG
9 N GRPLN,DIC,Y,DFN,GRPLN,HIGHLN,LASTLINE,VALMCNT
10 ;
11 ; - Division selection
12 I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
13 ;
14 ; - Patient selection
15 W !! S DIC=2,DIC(0)="QEAM" D ^DIC G EXIT:Y<0 S DFN=+Y
16 ;
17 D LST(PSOSITE,DFN)
18 Q
19 ;
20LST(SITE,PSODFN) ; - ListManager entry point
21 ; Loading Division/User preferences
22 D LOAD^PSOPMPPF(SITE,DUZ)
23 ;
24 W !,"Please wait..."
25 D EN^VALM("PSO PMP MAIN")
26 D FULL^VALM1
27 G EXIT
28 ;
29HDR ; - Header
30 N LINE,POS,LINE1,LINE2,LINE3,LINE4,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,GMRAL,ADVREA
31 ;
32 K VADM S DFN=PSODFN D DEM^VADPT
33 S PNAME=VADM(1)
34 S DOB=$S(+VADM(3):$P(VADM(3),"^",2)_" ("_$G(VADM(4))_")",1:"UNKNOWN")
35 S SEX=$P(VADM(5),"^",2)
36 S (WT,X)="",GMRVSTR="WT" D EN6^GMRVUTL I X'="" S WT=$J($P(X,"^",8)/2.2,6,2),WTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1)
37 S (HT,X)="",GMRVSTR="HT" D EN6^GMRVUTL I X'="" S HT=$J($P(X,"^",8)*2.54,6,2),HTDT=$$DAT^PSOPMP1($P(X,"^")\1,"/",1)
38 S LINE1=PNAME
39 S LINE1=$$ALLERGY^PSOPMP1(LINE1,DFN)
40 S LINE2=" PID: "_$P(VADM(2),"^",2),$E(LINE2,50)="HEIGHT(cm): "_$S(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE")
41 S LINE3=" DOB: "_DOB,$E(LINE3,50)="WEIGHT(kg): "_$S(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE")
42 S LINE4=" SEX: "_SEX,$E(LINE4,43)="EXP/CANCEL CUTOFF: "_PSOEXDCE_" DAYS"
43 ;
44 K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2,VALMHDR(3)=LINE3,VALMHDR(4)=LINE4
45 ;
46 D SETHDR^PSOPMP1()
47 Q
48 ;
49INIT ; - Populates the Body section for ListMan
50 K ^TMP("PSOPMP0",$J)
51 ;
52 D SETSORT(PSOSRTBY),SETLINE
53 S VALMSG="Select the entry # to view or ?? for more actions"
54 Q
55 ;
56SETLINE ; - Sets the line to be displayed in ListMan
57 N TYPE,STS,SUB,SEQ,LINE,Z,TOTAL,I,X,X1,ORDCNT,LBL,LN,IENSUB,GROUP,GRP,QTYL
58 I '$D(^TMP("PSOPMPSR",$J)) D Q
59 . F I=1:1:6 S ^TMP("PSOPMP0",$J,I,0)=""
60 . S ^TMP("PSOPMP0",$J,7,0)=" No prescriptions found for this patient."
61 . S VALMCNT=1
62 ;
63 ; - Resetting list to NORMAL video attributes
64 F I=1:1:$G(LASTLINE) D RESTORE^VALM10(I)
65 K GRPLN,HIGHLN
66 ;
67 ; - Building the list (line by line)
68 S (GROUP,STS,SUB)="",LINE=0 K ^TMP("PSOPMP0",$J)
69 F S GROUP=$O(^TMP("PSOPMPSR",$J,GROUP)) Q:GROUP="" D
70 . S GRP=$P(GROUP,"^")
71 . I GRP'["R"!('PSOSTSGP&($O(^TMP("PSOPMPSR",$J,GROUP),-1)'="")) D
72 . . D GROUP^PSOPMP1($P(GROUP,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP)),.LINE)
73 . F S STS=$O(^TMP("PSOPMPSR",$J,GROUP,STS)) Q:STS="" D
74 . . I STS'="<NULL>" D
75 . . . D GROUP^PSOPMP1($P(STS,"^",2),+$G(^TMP("PSOPMPSR",$J,GROUP,STS)),.LINE)
76 . . F S SUB=$O(^TMP("PSOPMPSR",$J,GROUP,STS,SUB),$S(PSORDER="A":1,1:-1)) Q:SUB="" D
77 . . . S Z=$G(^TMP("PSOPMPSR",$J,GROUP,STS,SUB))
78 . . . S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3)
79 . . . S QTYL=$L($P(Z,"^",4)) S:QTYL<5 QTYL=5
80 . . . I GRP["R"!(GRP["T") S $E(X1,5)=$P(Z,"^",2),$E(X1,19)=$E($P(Z,"^",3),1,(32-QTYL))
81 . . . I GRP["P"!(GRP["N") S $E(X1,5)=$P(Z,"^",3)
82 . . . I GRP["N" S $E(X1,49)="Date Documented:"
83 . . . I GRP'["N" S $E(X1,52-QTYL)=$J($P(Z,"^",4),QTYL),$E(X1,53)=$P(Z,"^",5),$E(X1,57)=$P(Z,"^",6)
84 . . . S $E(X1,66)=$P(Z,"^",7)
85 . . . S $E(X1,74)=$J($P(Z,"^",8),3),$E(X1,78)=$J($P(Z,"^",9),3)
86 . . . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X1,HIGHLN(LINE)=""
87 . . . S IENSUB=$S(GRP["R"!(GRP["T"):"RX",GRP["P":"PEN",1:"NVA")
88 . . . S ^TMP("PSOPMP0",$J,SEQ,IENSUB)=$P(Z,"^")
89 . . . I $G(PSOSIGDP) D SETSIG^PSOPMP1($S(GRP["R"!(GRP["T"):"R",GRP["P":"P",1:"N"),+Z,.LINE,PSODFN)
90 ;
91 ; - Saving NORMAL video attributes to be reset later
92 I LINE>$G(LASTLINE) D
93 . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
94 . S LASTLINE=LINE
95 ;
96 D VIDEO^PSOPMP1()
97 ;
98 S VALMCNT=+$G(LINE)
99 Q
100 ;
101SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified
102 N SEQ,RX,RXNUM,DRUG,DRNAME,QTY,STATUS,STS,ISSDT,DOCDAT,LSTFD,REFREM,DAYSUP,SIG,Z,ORD,GRPCNT,GROUP,RFRX,OI
103 ;
104 K ^TMP("PSOPMPSR",$J)
105 ;
106 ; - Loading prescription (file #55)
107 S SEQ=0
108 F S SEQ=$O(^PS(55,PSODFN,"P",SEQ)) Q:'SEQ D
109 . S RX=+$G(^PS(55,PSODFN,"P",SEQ,0)) I 'RX!($G(^PSRX(RX,0))="") Q
110 . I $$FILTER^PSOPMP1(RX) Q
111 . S RXNUM=$$GET1^DIQ(52,RX,.01)
112 . S DRUG=$$GET1^DIQ(52,RX,6,"I")
113 . S DRNAME=$$GET1^DIQ(50,DRUG,.01)
114 . S QTY=$$GET1^DIQ(52,RX,7)
115 . S STATUS=$$STSINFO^PSOPMP1(RX)
116 . S ISSDT=$$ISSDT^PSOPMP1(RX,"R")
117 . S LSTFD=$$LSTFD^PSOPMP1(RX)
118 . S REFREM=$$REFREM^PSOPMP1(RX)
119 . S DAYSUP=$$GET1^DIQ(52,RX,8)
120 . S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=RXNUM_$$COPAY^PSOPMP1(RX)_$$ECME^PSOBPSUT(RX),$P(Z,"^",3)=$E(DRNAME,1,30)
121 . S $P(Z,"^",4)=QTY,$P(Z,"^",5)=$P(STATUS,"^",3)_$$CMOP^PSOPMP1(DRUG,RX),$P(Z,"^",6)=$P(ISSDT,"^",2)
122 . S $P(Z,"^",7)=$P(LSTFD,"^",2),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP
123 . S SORT=$S(FIELD="RX":RXNUM_" ",FIELD="DR":DRNAME_RXNUM,FIELD="ID":+ISSDT_RXNUM_" ",FIELD="LF":+LSTFD_RXNUM_" ")
124 . S STS="<NULL>" I $G(PSOSTSGP) S STS=$P(STATUS,"^")_"^"_$P(STATUS,"^",2)
125 . S GROUP=$P(PSORDSEQ("R"),"^")_"R^"_$P(PSORDSEQ("R"),"^",2)
126 . I $$FIND^PSOREJUT(RX) S GROUP=$P(PSORDSEQ("T"),"^")_"T^"_$P(PSORDSEQ("T"),"^",2),STS="<NULL>"
127 . S ^TMP("PSOPMPSR",$J,GROUP,STS,SORT)=Z
128 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1,GRPCNT(GROUP,STS)=$G(GRPCNT(GROUP,STS))+1
129 ;
130 S GROUP=""
131 F S GROUP=$O(GRPCNT(GROUP)) Q:GROUP="" D
132 . S ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))
133 . S STS="" F S STS=$O(GRPCNT(GROUP,STS)) Q:STS="" D
134 . . S ^TMP("PSOPMPSR",$J,GROUP,STS)=GRPCNT(GROUP,STS)
135 ;
136 ; - Loading pending orders (file #52.41)
137 S ORD=0,GROUP=$P(PSORDSEQ("P"),"^")_"P^"_$P(PSORDSEQ("P"),"^",2)
138 F S ORD=$O(^PS(52.41,"P",PSODFN,ORD)) Q:'ORD D
139 . S TYPE=$$GET1^DIQ(52.41,ORD,2,"I")
140 . I TYPE="DC"!(TYPE="DE")!(TYPE="HD") Q
141 . S DRNAME="",DRUG=+$$GET1^DIQ(52.41,ORD,11,"I") I DRUG S DRNAME=$$GET1^DIQ(50,DRUG,.01)
142 . I DRNAME="" D Q:DRNAME=""
143 . . S OI=$$GET1^DIQ(52.41,ORD,8,"I") I 'OI Q
144 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)
145 . S QTY=$$GET1^DIQ(52.41,ORD,12)
146 . S STATUS=$$GET1^DIQ(52.41,ORD,2,"I")
147 . S ISSDT=$$ISSDT^PSOPMP1(ORD,"P")
148 . S REFREM=$$GET1^DIQ(52.41,ORD,13)
149 . S DAYSUP=$$GET1^DIQ(52.41,ORD,101)
150 . S RFRX="" I STATUS="RF" S RFRX=$$GET1^DIQ(52.41,ORD,21,"I") I RFRX S RFRX=$$GET1^DIQ(52,RFRX,.01)
151 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,45),$P(Z,"^",4)=QTY,$P(Z,"^",5)=$E(STATUS,1,2)_$$CMOP^PSOPMP1(DRUG)
152 . S $P(Z,"^",6)=$S(RFRX'="":"Rx#: "_RFRX,1:$P(ISSDT,"^",2)),$P(Z,"^",8)=REFREM,$P(Z,"^",9)=DAYSUP
153 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":+ISSDT_ORD,FIELD="LF":+ISSDT_ORD)
154 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z
155 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1
156 ;
157 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))
158 ;
159 ; - Loading Non-VA Med orders (file #55, sub-file #55.05)
160 S ORD=0,GROUP=$P(PSORDSEQ("N"),"^")_"N^"_$P(PSORDSEQ("N"),"^",2)
161 F S ORD=$O(^PS(55,PSODFN,"NVA",ORD)) Q:'ORD D
162 . I $$GET1^DIQ(55.05,ORD_","_PSODFN,5,"I") Q
163 . S DRNAME=$$GET1^DIQ(55.05,ORD_","_PSODFN,1)
164 . I DRNAME="" D Q:DRNAME=""
165 . . S OI=$$GET1^DIQ(55.05,ORD_","_PSODFN,.01,"I") I 'OI Q
166 . . S DRNAME=$$GET1^DIQ(50.7,OI,.01)_" "_$$GET1^DIQ(50.7,OI,.02)
167 . S DOCDAT=$P($$GET1^DIQ(55.05,ORD_","_PSODFN_",",11,"I"),".")
168 . S Z="",$P(Z,"^")=ORD,$P(Z,"^",3)=$E(DRNAME,1,38),$P(Z,"^",7)=$$DAT^PSOPMP1(DOCDAT,"-")
169 . S SORT=$S(FIELD="RX":DRNAME_ORD,FIELD="DR":DRNAME_ORD,FIELD="ID":DOCDAT_ORD,FIELD="LF":DOCDAT_ORD)
170 . S ^TMP("PSOPMPSR",$J,GROUP,"<NULL>",SORT)=Z
171 . S GRPCNT(GROUP)=$G(GRPCNT(GROUP))+1
172 ;
173 S:$G(GRPCNT(GROUP)) ^TMP("PSOPMPSR",$J,GROUP)=$G(GRPCNT(GROUP))
174 ;
175 Q
176 ;
177RX ; - Sort by Rx
178 D SORT("RX")
179 Q
180DR ; - Sort by Drug
181 D SORT("DR")
182 Q
183ID ; - Sort by Issue Date
184 D SORT("ID")
185 Q
186LF ; - Sort by Last Fill Date
187 D SORT("LF")
188 Q
189 ;
190SORT(FIELD) ; - Sort entries by FIELD
191 I PSOSRTBY=FIELD S PSORDER=$S(PSORDER="A":"D",1:"A")
192 E S PSOSRTBY=FIELD,PSORDER="A"
193 D REF
194 Q
195 ;
196REF ; - Screen Refresh
197 W ?52,"Please wait..." D INIT,HDR S VALMBCK="R"
198 Q
199GS ; - Group by Status
200 W ?52,"Please wait..." S PSOSTSGP=$S($G(PSOSTSGP):0,1:1) D INIT,HDR S VALMBCK="R"
201 Q
202 ;
203SIG ; - Display SIG
204 W ?52,"Please wait..." S PSOSIGDP=$S($G(PSOSIGDP):0,1:1) D INIT,HDR S VALMBCK="R"
205 I 'PSOSIGDP S VALMBG=VALMBG\2
206 I PSOSIGDP S VALMBG=VALMBG*2-1
207 S:VALMBG>(VALMCNT-10) VALMBG=VALMCNT-10 S:VALMBG<1 VALMBG=1
208 Q
209 ;
210PI ; - Patient Information
211 D EN^PSOLMPI S VALMBCK="R"
212 Q
213 ;
214CV ; - Change View
215 D LST^PSOPMPPF(SITE,DUZ) W !?52,"Please wait..." D INIT,HDR
216 S VALMBG=1,VALMBCK="R"
217 Q
218 ;
219SEL ; - Process selection of one entry
220 N PSOSEL,TYPE,XQORM,ORD,TITLE
221 S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
222 S TYPE=$O(^TMP("PSOPMP0",$J,PSOSEL,0)) I TYPE="" S VALMSG="Invalid selection!",VALMBCK="R" Q
223 S ORD=$G(^TMP("PSOPMP0",$J,PSOSEL,TYPE))
224 I 'ORD S VALMSG="Invalid selection!",VALMBCK="R" Q
225 S TITLE=VALM("TITLE")
226 ;
227 ; - Regular prescription
228 I TYPE="RX" D
229 . N PSOVDA,PSOSAVE,DA,PS
230 . S (PSOVDA,DA)=ORD,PS="REJECT"
231 . N LINE,TITLE,PSODFN D DP^PSORXVW
232 ;
233 ; - Pending Order
234 I TYPE="PEN" D
235 . N PSOACTOV,OR0
236 . S OR0=^PS(52.41,ORD,0),PSOACTOV=""
237 . N LINE,TITLE D PENHDR^PSOPMP1(PSODFN),DSPL^PSOORFI1
238 ;
239 ; - Pending Order
240 I TYPE="NVA" D
241 . N LINE,TITLE D EN^PSONVAVW(PSODFN,ORD)
242 ;
243 S VALMBCK="R",VALM("TITLE")=TITLE
244 Q
245 ;
246EXIT ;
247 K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J)
248 Q
249 ;
250HELP Q
Note: See TracBrowser for help on using the repository browser.