source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBBK.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1ALPBBK ;OIFO-DALLAS MW,SED,KC,KCF PRINT BLANK MAR BCMA FOR SELECTED PATIENT ;04/25/03
2 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
3 ;
4 ; NOTE: this routine is designed for hard-copy output.
5 ; Output is formatted for 132-column printing.
6 ;
7 F D Q:$D(DIRUT)
8 .W !!,"Inpatient Pharmacy Orders for a selected patient"
9 .S DIR(0)="PAO^53.7:QEMZ"
10 .S DIR("A")="Select PATIENT NAME: "
11 .D ^DIR K DIR
12 .I $D(DIRUT) K X,Y Q
13 .S ALPBIEN=+Y
14 .S ALPBPTN=Y(0,0)
15 .S %ZIS="Q"
16 .S %ZIS("B")=$$DEFPRT^ALPBUTL()
17 .I %ZIS("B")="" K %ZIS("B")
18 .; print how many days MAR?...
19 .S DIR(0)="NA^3:7"
20 .S DIR("A")="Print how many days MAR? "
21 .S DIR("B")=$$DEFDAYS^ALPBUTL()
22 .S DIR("?")="The default is shown; you may select 3 or 7."
23 .W ! D ^DIR K DIR
24 .I $D(DIRUT) K ALPBOTYP,DIRUT,DTOUT,X,Y Q
25 .S ALPBDAYS=+Y
26 .;
27 .W ! D ^%ZIS K %ZIS
28 .I POP D Q
29 ..K ALPBIEN,ALPBPTN,POP
30 .;
31 .; output not queued...
32 .I '$D(IO("Q")) D
33 ..U IO
34 ..D DQ
35 ..I IO'=IO(0) D ^%ZISC
36 .;
37 .; set up the Task...
38 .I $D(IO("Q")) D
39 ..S ZTRTN="DQ^ALPBBK"
40 ..S ZTIO=ION
41 ..S ZTDESC="PSB INPT PHARM ORDERS FOR "_ALPBPTN
42 ..S ZTSAVE("ALPBDAYS")=""
43 ..S ZTSAVE("ALPBIEN")=""
44 ..S ZTSAVE("ALPBMLOG")=""
45 ..S ZTSAVE("ALPBOTYP")=""
46 ..D ^%ZTLOAD
47 ..D HOME^%ZIS
48 ..W !!,$S(+$G(ZTSK):"Task "_ZTSK_" queued.",1:"ERROR: NOT QUEUED!")
49 ..K IO("Q"),ZTSK
50 .;
51 .K ALPBDAYS,ALPBIEN,ALPBMLOG,ALPBOTYP,ALPBPTN,X,Y
52 K DIRUT,DTOUT,X,Y
53 Q
54 ;
55DQ ; output entry point...
56 K ^TMP($J)
57 ;
58 ; set report date...
59 S ALPBRDAT=$$DT^XLFDT()
60 S ALPBPT(0)=$G(^ALPB(53.7,ALPBIEN,0))
61 M ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
62 S ALPBPG=1
63 D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
64 F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
65 K ALPBHDR
66 S FOOT=0
67 S DAY=ALPBDAYS
68 S FOOT=FOOT+1 S MST=$S(DAY=3:83,DAY=7:105,DAY=14:140)
69 S NST=$S(DAY=3:95,DAY=7:120,DAY=14:135)
70 W !?61,"Admin" D MON^ALPBUTL3(DAY) W ?74,MON D ARRAY^ALPBUTL3(DAY)
71 W !,?2,"Order",?13,"Start",?35,"Stop",?61,"Times" D START^ALPBUTL3(DAY) W ?NST,"Notes"
72 W ! F J=1:1:142 W "-"
73 S ADM(7)=""
74 F JY=1:0:4 DO Q:JY=5
75 .W !,"____________|______________________|___________________",?59," |",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
76 .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
77 .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
78 .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
79 .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
80 .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
81 .W !!!,?5,"RPH Verify:___________ Nurse Verify:____________"
82 .W ! F J=1:1:142 W "-"
83 .S JY=JY+1
84 D STOP
85 Q
86STOP D FOOT
87 K PTNAME,WARD,SSN,BED,ST,ROOM,Y,DOB,J,IENM,DFN,NST,ANS,FOOT,SEX,ADMIN(7),PCOUNT,CURRENT,MST
88 Q
89FOOT ;FOOTER TO FROMS
90 W !,"|",?13,"SIGNATURE/TITLE",?40,"| INIT",?48,"|",?60,"INJECTION SITES",?87,"|",?92,"MED/DOSE OMITTED",?115,"|",?120,"REASON",?132,"|",?135,"INIT",?140,"|"
91 W !,"|" F J=2:1:39 W "-"
92 W ?40,"|" F J=41:1:47 W "-"
93 W ?48,"|" F J=49:1:84 W "-"
94 W ?87,"|" F J=88:1:114 W "-"
95 W ?115,"|" F J=116:1:131 W "-"
96 W ?132,"|" F J=133:1:139 W "-"
97 W ?140,"|"
98 W !,"|" F J=2:1:39 W "-"
99 W ?40,"|" F J=41:1:47 W "-"
100 W ?48,"|"
101 W ?52,"Indicate RIGHT (R) or LEFT (L)"
102 W ?87,"|" F J=88:1:114 W "-"
103 W ?115,"|" F J=116:1:131 W "-"
104 W ?132,"|" F J=133:1:139 W "-"
105 W ?140,"|"
106 W !,"|" F J=2:1:39 W "-"
107 W ?40,"|" F J=41:1:47 W "-"
108 W ?48,"|"
109 W ?87,"|" F J=88:1:112 W "-"
110 W ?115,"|" F J=116:1:129 W "-"
111 W ?132,"|" F J=133:1:137 W "-"
112 W ?140,"|"
113 W !,"|" F J=2:1:39 W "-"
114 W ?40,"|" F J=41:1:47 W "-"
115 W ?48,"|"
116 W ?53,"(IM)",?75,"(SUB Q)"
117 W ?87,"|" F J=88:1:114 W "-"
118 W ?115,"|" F J=116:1:131 W "-"
119 W ?132,"|" F J=133:1:139 W "-"
120 W ?140,"|"
121 W !,"|" F J=2:1:39 W "-"
122 W ?40,"|" F J=41:1:47 W "-"
123 W ?48,"|"
124 W ?49,"1. DELTOID",?73,"6. UPPER ARM"
125 W ?87,"|" F J=88:1:114 W "-"
126 W ?115,"|" F J=116:1:131 W "-"
127 W ?132,"|" F J=133:1:139 W "-"
128 W ?140,"|"
129 W !,"|" F J=2:1:39 W "-"
130 W ?40,"|" F J=41:1:47 W "-"
131 W ?48,"|"
132 W ?49,"2. VENTRAL GLUTEAL",?73,"7. ABDOMEN"
133 W ?87,"|" F J=88:1:114 W "-"
134 W ?115,"|" F J=116:1:131 W "-"
135 W ?132,"|" F J=133:1:139 W "-"
136 W ?140,"|"
137 W !,"|" F J=2:1:39 W "-"
138 W ?40,"|" F J=41:1:47 W "-"
139 W ?48,"|"
140 W ?49,"3. GLUTEUS MEDIUS",?73,"8. THIGH"
141 W ?87,"|" F J=88:1:114 W "-"
142 W ?115,"|" F J=116:1:131 W "-"
143 W ?132,"|" F J=133:1:139 W "-"
144 W ?140,"|"
145 W !,"|" F J=2:1:39 W "-"
146 W ?40,"|" F J=41:1:47 W "-"
147 W ?48,"|"
148 W ?49,"4. MED (ANTERIOR) THIGH",?73,"9. BUTTOCK"
149 W ?87,"|" F J=88:1:114 W "-"
150 W ?115,"|" F J=116:1:131 W "-"
151 W ?132,"|" F J=133:1:139 W "-"
152 W ?140,"|"
153 W !,"|" F J=2:1:39 W "-"
154 W ?40,"|" F J=41:1:47 W "-"
155 W ?48,"|"
156 W ?49,"5. VASTUS LATERALIS",?73,"10. UPPER BACK"
157 W ?87,"|" F J=88:1:114 W "-"
158 W ?115,"|" F J=116:1:131 W "-"
159 W ?132,"|" F J=133:1:139 W "-"
160 W ?140,"|"
161 W !,"|" F J=2:1:39 W "-"
162 W ?40,"|" F J=41:1:47 W "-"
163 W ?48,"|"
164 W ?50," PRN: E=Effective N=Not Effective"
165 W ?87,"|" F J=88:1:114 W "-"
166 W ?115,"|" F J=116:1:131 W "-"
167 W ?132,"|" F J=133:1:139 W "-"
168 W ?140,"|"
169 W ! F J=1:1:140 W "-"
170 W ?140,"|"
171 K ALPBDAYS,DAY,ALPBOIEN,ALPBORDN,ALPBOST,ALPBOTYP,ALPBPG,ALPBPT,ALPBRDAT,^TMP($J)
172 I $D(ZTQUEUED) S ZTREQ="@"
173 ;
174 ; write form feed at end if output device is a printer...
175 I $E(IOST)="P" W @IOF
176 Q
Note: See TracBrowser for help on using the repository browser.