source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBFRM1.m@ 1789

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

initial load of WorldVistAEHR

File size: 7.9 KB
Line 
1ALPBFRM1 ;OIFO-DALLAS MW,SED,KC -STANDARD PRINT FORMATTING UTIL;01/01/03
2 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
3 ;
4F132(DATA,DAYS,MLCNT,RESULTS,ALPPAT) ; format data into a 132-column
5 ; output array...
6 ; DATA = an array containing a specific order node for a selected
7 ; patient in file 53.7
8 ; DAYS = a number that represents the number of initial boxes
9 ; (1 box = 1 day) to add to lines 4-10 (max=7 -- note that
10 ; this is usually a 3-day MAR, but a 7-day MAR could be
11 ; returned from this format utility)
12 ; MLCNT = Number of Med-log entries to print with orders
13 ; RESULTS = an array passed by reference into which the formatted
14 ; entry is set up returns a formatted array in RESULTS
15 ; (note: total line count is returned at RESULTS(0))
16 I $D(DATA)="" Q
17 ;
18 N ALPBADM,ALPBDAYS,ALPBDRUG,ALPBIBOX,ALPBNBOX,ALPBPBOX,ALPBSTOP,ALPBTEXT,ALPBTIME,ALPBX,DATE,LINE,BOLDON,BOLDOFF,X,ALPBPRNG,ALPBFLG,ALPBPRN,ALPBMLC
19 ; to use BOLD, comment out the next line and remove comments from
20 ; the following five lines...
21 S BOLDON="<<",BOLDOFF=">>"
22 ;S X="IOINHI;IOINORM"
23 ;D ENDR^%ZISS
24 ;S BOLDON=$G(IOINHI)
25 ;S BOLDOFF=$G(IOINORM)
26 ;D KILL^%ZISS
27 ;
28 ;S MLCNT=$S(+$P($G(^ALPB(53.71,1,2)),U,4)>0:+$P(^ALPB(53.71,1,2),U,4),1:1)
29 I $G(DAYS)="" S DAYS=3
30 I DAYS>7 S DAYS=7
31 S DATE=$$DT^XLFDT()
32 D FDATES^ALPBUTL(DATE,DAYS,.ALPBDAYS)
33 ; get administration timing (needed for formatting various lines)
34 S ALPBX=$P($G(DATA(4)),"^",4)
35 I ALPBX="" S ALPBADM=0
36 I ALPBX'="" D
37 .S ALPBADM=0
38 .F I=1:1 Q:$P(ALPBX,"-",I)="" D
39 ..S ALPBADM(I)=$P(ALPBX,"-",I)
40 ..S ALPBADM=ALPBADM+1
41 ; line 1...
42 S RESULTS(1)=""
43 S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),66)_"Admin"
44 ; line 2...
45 S RESULTS(2)="Start"
46 S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),25)_"Stop"
47 S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),66)_"Times"
48 S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),74)_ALPBDAYS(0)
49 I DAYS=3 S RESULTS(2)=RESULTS(2)_" Notes"
50 ; line 3...
51 S RESULTS(3)=$$REPEAT^XLFSTR("-",132)
52 ; line 4...
53 ; start and stop date/times...
54 S RESULTS(4)=$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"Not on file")
55 S RESULTS(4)=$$PAD^ALPBUTL(RESULTS(4),25)_$S($P($G(DATA(1)),"^",2)'="":$$FMTE^XLFDT($P(DATA(1),"^",2)),1:"Not on file")
56 ;
57 ; end of fixed line format, continue...
58 S LINE=4
59 ; get drug(s)...
60 I +$O(DATA(7,0)) D
61 .S LINE=LINE+1
62 .S RESULTS(LINE)=""
63 .S ALPBX=0
64 .F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
65 ..S ALPBDRUG=$G(BOLDON)_$P(DATA(7,ALPBX,0),"^",2)_$G(BOLDOFF)
66 ..;S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
67 ..S RESULTS(LINE)=$G(RESULTS(LINE))_ALPBDRUG
68 ..K ALPBDRUG
69 ..I +$O(DATA(7,ALPBX)) S LINE=LINE+1
70 ; any additives...
71 I +$O(DATA(8,0)) D
72 .S LINE=LINE+1
73 .S RESULTS(LINE)=" Additive(s): "
74 .S ALPBX=0
75 .F S ALPBX=$O(DATA(8,ALPBX)) Q:'ALPBX D
76 ..S ALPBDRUG=$P(DATA(8,ALPBX,0),"^",2)
77 ..; if UNITS is not already contained in ADDITIVE NAME, add it...
78 ..I $P(DATA(8,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(8,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(8,ALPBX,0),"^",3)
79 ..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
80 ..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
81 ..K ALPBDRUG
82 ..I +$O(DATA(8,ALPBX)) D
83 ...S LINE=LINE+1
84 ...S RESULTS(LINE)=" "
85 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
86 .K ALPBX
87 ; any solutions...
88 I +$O(DATA(9,0)) D
89 .S LINE=LINE+1
90 .S RESULTS(LINE)=" Solution(s): "
91 .S ALPBX=0
92 .F S ALPBX=$O(DATA(9,ALPBX)) Q:'ALPBX D
93 ..S ALPBDRUG=$P(DATA(9,ALPBX,0),"^",2)
94 ..; if UNITS is not already contained in SOLUTION NAME, add it...
95 ..I $P(DATA(9,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(9,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(9,ALPBX,0),"^",3)
96 ..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
97 ..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
98 ..K ALPBDRUG
99 ..I +$O(DATA(9,ALPBX)) D
100 ...S LINE=LINE+1
101 ...S RESULTS(LINE)=" "
102 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
103 .K ALPBX
104 ; give ($P(DATA(4),"^",1)=DOSAGE $P(DATA(4),"^",2)=ROUTE $P(DATA(4),"^",3)=SCHEDULE)...
105 S LINE=LINE+1
106 S RESULTS(LINE)=" Give: "_$P($G(DATA(4)),"^")_" "_$P($G(DATA(4)),"^",2)_" "_$P($G(DATA(4)),"^",3)
107 ;Set PRN Flag
108 S ALPBPRNG=0
109 S:$P($G(DATA(4)),"^",3)["PRN" ALPBPRNG=1
110 ;
111 ; provider comments, special instructions, and other print info...
112 I +$O(DATA(5,0)) D
113 .K ALPBCMNT
114 .M ALPBCMNT=DATA(5)
115 .S ALPBCOL=60
116 .D FTEXT^ALPBFRMU(ALPBCOL,.ALPBCMNT,.ALPBTEXT)
117 .K ALPBCMNT
118 .S ALPBX=0
119 .F S ALPBX=$O(ALPBTEXT(ALPBX)) Q:'ALPBX D
120 ..S ALPBLINE=ALPBTEXT(ALPBX,0)
121 ..S LINE=LINE+1
122 ..S RESULTS(LINE)=ALPBLINE
123 .K ALPBCOL,ALPBLINE,ALPBTEXT,ALPBX
124 ;S LINE=LINE+1,RESULTS(LINE)=""
125 ;
126 ; provider, pharmacist or entry person, and verifier...
127 S LINE=LINE+1
128 S RESULTS(LINE)=" Provider: "_$P($G(DATA(2)),"^")
129 S LINE=LINE+1
130 S RESULTS(LINE)="RPh/Entry by: "_$P($G(DATA(2)),"^",2)
131 I $P($G(DATA(2)),"^",3)'="" D
132 .S LINE=LINE+1
133 .S RESULTS(LINE)=" Verified by: "_$P(DATA(2),"^",3)
134 ; order number and type...
135 S LINE=LINE+1
136 S RESULTS(LINE)=" Order #: "_$P(DATA(0),"^")
137 S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),25)_"Type: "_$$OTYP^ALPBUTL($P($G(DATA(3)),"^"))
138 ; order status...
139 S LINE=LINE+1
140 S RESULTS(LINE)=" Status: "_$P($P(DATA(0),"^",3),"~",2)
141 ;
142 ; med log data...
143 S LINE=LINE+1
144 S RESULTS(LINE)="BCMA MEDICATION LOG HISTORY"
145 ;I $G(MLDATE)'="" S RESULTS(LINE)=RESULTS(LINE)_" (since "_$$FMTE^XLFDT(MLDATE)_")"
146 I +$O(DATA(10,0))=0 D
147 .S LINE=LINE+1
148 .S RESULTS(LINE)=" No Medication Log entries are on file for this order."
149 I +$O(DATA(10,0)) D
150 .S LINE=LINE+1
151 .S RESULTS(LINE)=" Log Date"
152 .S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
153 .S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
154 .I $O(DATA(10,"IMLOG",0))="" D
155 ..S LINE=LINE+1
156 ..S RESULTS(LINE)=" No entries since the above date are on file."
157 .;S ALPBMDT=MLDATE
158 .S ALPBMDT=0,ALPBMLC=1
159 .F S ALPBMDT=$O(DATA(10,"IMLOG",ALPBMDT)) Q:'ALPBMDT!(ALPBMLC>MLCNT) D
160 ..S ALPBX=0
161 ..F S ALPBX=$O(DATA(10,"IMLOG",ALPBMDT,ALPBX)) Q:'ALPBX!(ALPBMLC>MLCNT) D
162 ...S LINE=LINE+1,ALPBMLC=ALPBMLC+1
163 ...S RESULTS(LINE)=" "_$$FDATE^ALPBUTL($P(DATA(10,ALPBX,0),"^",1))
164 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(DATA(10,ALPBX,0),"^",3)
165 ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$S($P(DATA(10,ALPBX,0),"^",2)'="":$P(DATA(10,ALPBX,0),"^",2),1:"<not on file")
166 ..K ALPBX
167 .K ALPBMDT,ALPBMLC
168 ;
169 ; BCMA LAST ACTION
170 I +$G(ALPPAT)>0 D
171 .S ALPBX=0
172 .F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
173 ..S ALPDRUG=$P(DATA(7,ALPBX,0),"^",1),ALPBDNM=$P(DATA(7,ALPBX,0),"^",2)
174 ..Q:+ALPDRUG'>0
175 ..S ALPLACT=$$LACT^ALPBUTL3(ALPPAT,ALPDRUG)
176 ..I ALPLACT'="" D
177 ...S LINE=LINE+1,RESULTS(LINE)=$$REPEAT^XLFSTR("-",75)
178 ...S LINE=LINE+1
179 ...S RESULTS(LINE)="Last action for "_ALPBDNM_" "_" was "_$P(ALPLACT,"^",3)_" on "_$$FDATE^ALPBUTL($P(ALPLACT,"^",1))
180 ...S RESULTS(LINE)=RESULTS(LINE)_" By "_$S($P(ALPLACT,"^",2)'="":$P(ALPLACT,"^",2),1:"<not on file>")
181 K ALPLACT,ALPDRUG,ALPBX
182 ;
183 I LINE<11 F I=1:1 Q:LINE=11 D
184 .S LINE=LINE+1
185 .S RESULTS(LINE)=""
186 ;
187 ; now add admin times and initial boxes to lines 4-10 as required
188 ; by number of administration times...
189 S ALPBIBOX="______|"
190 S ALPBNBOX="******|"
191 I +$G(ALPBADM)=0 S ALPBADM=8
192 ;S ALPBPRN=ALPBADM+4
193 S ALPBSTOP=$P($G(DATA(1)),"^",2)
194 F I=1:1:ALPBADM D
195 .S ALPBPRN=I+3
196 .S ALPBADMT=$G(ALPBADM(I))
197 .I ALPBADMT="" S ALPBADMT=" "
198 .I '$D(RESULTS(I+3)) D
199 ..S RESULTS(I+3)=" "
200 ..S LINE=LINE+1
201 .S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
202 .S RESULTS(I+3)=RESULTS(I+3)_$S($L(ALPBADMT)=2:ALPBADMT_"00",1:ALPBADMT)
203 .S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),74)_"|"
204 .F J=1:1:DAYS D
205 ..S ALPBDAY=ALPBDAYS(J)_"."_ALPBADMT
206 ..S ALPBPBOX=ALPBIBOX
207 ..I ALPBDAY=ALPBSTOP!(ALPBDAY>ALPBSTOP) S ALPBPBOX=ALPBNBOX
208 ..S RESULTS(I+3)=RESULTS(I+3)_ALPBPBOX
209 .K ALPBADMT,ALPBPBOX,ALPBDAY
210 K ALPBIBOX,ALPBNBOX
211 ; if PRN med, add line for documenting effectiveness...
212 I +ALPBPRNG D
213 .S ALPBFLG=0,ALPBPRN=ALPBPRN+1
214 .S:'$D(RESULTS(ALPBPRN)) RESULTS(ALPBPRN)=" ",ALPBFLG=1
215 .S RESULTS(ALPBPRN)=$$PAD^ALPBUTL(RESULTS(ALPBPRN),63)_" PRN Effectiveness:_____________"
216 .S:ALPBFLG LINE=LINE+1
217 S LINE=LINE+1
218 S RESULTS(LINE)=$$REPEAT^XLFSTR("-",132)
219 S RESULTS(0)=LINE
220 Q
Note: See TracBrowser for help on using the repository browser.