source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBODL1.m

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

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1PSBODL1 ;BIRMINGHAM/VRN-DUE LIST ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;**5,9,32**;Mar 2004;Build 32
3 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
4 ;
5 ; Reference/IA
6 ; ^XLFDT/10103
7EN ;
8 S PSBFOHDR=0
9 S PSBORD=0 F S PSBORD=$O(^TMP("PSBO",$J,DFN,PSBORD)) Q:PSBORD="" S PSBTYPE=$O(^TMP("PSBO",$J,DFN,PSBORD,"")) D
10 .D CLEAN^PSBVT
11 .D PSJ1^PSBVT(DFN,PSBORD)
12 .I PSBSCHT="C" D Q:PSBADMIN=""
13 ..S PSBX=PSBADST,PSBFLAG=1
14 ..I PSBX="",PSBONX["V",PSBIVT'="P" S PSBFLAG=0
15 ..S (PSBYES,PSBODD)=0
16 ..S:$$PSBDCHK1^PSBVT1(PSBSCH) PSBYES=1
17 ..F I=1:1 Q:$P(PSBSCH,"-",I)="" I $P(PSBSCH,"-",I)?2N!($P(PSBSCH,"-",I)?4N) S PSBYES=1
18 ..I PSBYES,PSBADST="",PSBSCHT'="O",PSBSCHT'="OC",PSBSCHT'="P" Q
19 ..I PSBFREQ="O" S PSBFREQ=1440
20 ..I 'PSBYES,PSBADST="",PSBFREQ<1 Q
21 ..I +PSBFREQ>0 I (PSBFREQ#1440'=0),(1440#PSBFREQ'=0) S PSBODD=1
22 ..I PSBODD,PSBADST'="" Q
23 ..D:PSBX=""
24 ...I PSBIVT="C",PSBCHEMT="A" S PSBX="0000",PSBFLAG=0
25 ...I PSBIVT="C",PSBISYR=0 S PSBX="0000",PSBFLAG=0
26 ...I PSBIVT="S",PSBISYR=0 S PSBX="0000",PSBFLAG=0
27 ...I "HA"[PSBIVT S PSBX="0000",PSBFLAG=0
28 ..I ("SC"[PSBIVT),(PSBISYR=1) S PSBX=""
29 ..I (PSBIVT="C"),(PSBCHEMT="P") S PSBX=""
30 ..I PSBOTYP="U",PSBX="0000" S PSBX=""
31 ..I PSBIVT="P",$G(PSBX)=0 S PSBX=""
32 ..I PSBX="" S PSBX=$$GETADMIN^PSBVDLU1(DFN,PSBONX,PSBOST,PSBFREQ,PSBEVDT)
33 ..E K ^TMP("PSB",$J,"GETADMIN") S ^TMP("PSB",$J,"GETADMIN",0)=PSBX
34 ..S PSBADMIN=""
35 ..F PSBXX=0:1 Q:'$D(^TMP("PSB",$J,"GETADMIN",PSBXX)) S PSBX=$G(^TMP("PSB",$J,"GETADMIN",PSBXX)) D
36 ...F PSBY=1:1:$L(PSBX,"-") D
37 ....Q:($P(PSBX,"-",PSBY)'?2N)&($P(PSBX,"-",PSBY)'?4N)
38 ....S PSBAT=+(PSBODATE_"."_$P(PSBX,"-",PSBY))
39 ....I PSBFLAG Q:PSBAT<PSBOSTRT!(PSBAT>PSBOSTOP) ; Report Window
40 ....D VAL^PSBMLVAL(.PSBZ,DFN,PSBONX,PSBTYPE,PSBAT)
41 ....S:$G(PSBFREQ)>29 PSBADMIN=PSBADMIN_$S(PSBADMIN]"":"-",1:"")_$P(PSBX,"-",PSBY)
42 ....S:$G(PSBFREQ)<30 PSBADMIN="Due every "_$G(PSBFREQ)_" minutes."
43 .I PSBSCHT'="C" S PSBADMIN=PSBADST
44 .; Get LAST GIVEN date/time
45 .S PSBLGDT="",X=""
46 .F S X=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,X),-1) Q:'X D Q:PSBLGDT
47 ..S PSBIEN=""
48 ..F S PSBIEN=$O(^PSB(53.79,"AOIP",DFN,+PSBOIT,X,PSBIEN),-1) Q:PSBIEN="" D Q:PSBLGDT
49 ...S:"MHNR"'[$P($G(^PSB(53.79,PSBIEN,0)),U,9) PSBLGDT=X
50 .I $Y>(IOSL-12) I $Y<(IOSL-4) W !?(IOM-36\2),"(Medications Continued on Next Page)",$$FTR(),$$HDR()
51 .I PSBSM S PSBSM=$S(PSBSMX:"H",1:"")_"SM"
52 .E S PSBSM=""
53 .I 'PSBFOHDR S PSBFOHDR=1 W $$HDR()
54 .W !,$J(PSBSM,3),?6,PSBTYPE,$E(PSBSCHT,1,4),?12 S PSBWFLAG=1
55 .S X="",Y=0
56 .W $$WRAP(14,34,PSBOITX)
57 .S PSBADM="Give: "_PSBDOSE_" "_PSBSCH
58 .W $$WRAP(50,27,PSBADM)
59 .W $$WRAP(78,6,PSBMR)
60 .W ?85 I PSBLGDT W $E(PSBLGDT,4,5),"/",$E(PSBLGDT,6,7),"/",$E(PSBLGDT,2,3) W "@",$E($P(PSBLGDT,".",2)_"0000",1,4)
61 .W ?100,$P($TR($$FMTE^XLFDT(PSBOST,2),"@"," ")," ")
62 .W ?110,$P($TR($$FMTE^XLFDT(PSBOSP,2),"@"," ")," ")
63 .W ?120,$S(PSBVPHI]"":PSBVPHI,1:"***"),"/",$S(PSBVNI]"":PSBVNI,1:"***")
64 .W !,?100,"@"_$P(PSBOSTX," ",2),?110,"@"_$P(PSBOSPX," ",2)
65 .W IOINHI ; To Highlight the Dispense Drugs...
66 .I $D(PSBDDA) S Y=0 F S Y=$O(PSBDDA(Y)) Q:'Y D
67 ..Q:$P(PSBDDA(Y),U,5)&($P(PSBDDA(Y),U,5)<PSBNOW)
68 ..W !?14,"*",$$WRAP(15,33,$P(PSBDDA(Y),U,3)_" ("_+$P(PSBDDA(Y),U,2)_")")
69 .I $D(PSBADA) S Y=0 F S Y=$O(PSBADA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBADA(Y),U,3)_" ("_$P(PSBADA(Y),U,4)_")")
70 .I $D(PSBSOLA) S Y=0 F S Y=$O(PSBSOLA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBSOLA(Y),U,3)_" ("_$P(PSBSOLA(Y),U,4)_")")
71 .W IOINORM ; Highlight Off
72 .S PSBADM=$S(PSBADMIN]"":"Admin Times: "_PSBADMIN,1:"")
73 .W:PSBADM]"" $$WRAP(50,27,PSBADM)
74 .S X=$S(PSBOTXT]"":PSBOTXT,1:"<None Entered>")
75 .I $E(X,1)="!" S $E(X,1)=""
76 .W $$WRAP(14,34,"Spec Inst: "_X),!,$TR($J("",IOM)," ","-")
77 I '$G(PSBWFLAG) W !!,?10,"** NO SPECIFIED MEDICATIONS TO PRINT **"
78 W:PSBFOHDR $$BLANKS(),$$FTR()
79 Q
80 ;
81WRAPPUP ;Do wrapping per PSBODL (Due List Report)
82 ;
83 W $$WRAP(14,34,PSBMED)
84 S PSBADM="Give: "_PSBDOSE_" "_PSBSCH
85 W $$WRAP(50,27,PSBADM),?78,$$WRAP(78,6,PSBMR)
86 W ?85 D:PSBLGDT
87 .W $E(PSBLGDT,4,5),"/",$E(PSBLGDT,6,7),"/",$E(PSBLGDT,2,3),"@",$E($P(PSBLGDT,".",2)_"0000",1,4)
88 W ?100,$P($TR($$FMTE^XLFDT(PSBOST,2),"@"," ")," "),?110,$P($TR($$FMTE^XLFDT(PSBOSP,2),"@"," ")," "),?120,$S(PSBVPHI]"":PSBVPHI,1:"***"),"/"
89 W $S(PSBVNI]"":PSBVNI,1:"***"),!,?100,"@"_$P(PSBOSTX," ",2),?110,"@"_$P(PSBOSPX," ",2)
90 W IOINHI
91 I $D(PSBDDA) S Y=0 F S Y=$O(PSBDDA(Y)) Q:'Y D
92 .Q:$P(PSBDDA(Y),U,5)&($P(PSBDDA(Y),U,5)<PSBNOW)
93 .W !?14,"*",$$WRAP(15,33,$P(PSBDDA(Y),U,3)_" ("_+$P(PSBDDA(Y),U,2)_")")
94 I $D(PSBADA) S Y=0 F S Y=$O(PSBADA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBADA(Y),U,3)_" ("_$P(PSBADA(Y),U,4)_")")
95 I $D(PSBSOLA) S Y=0 F S Y=$O(PSBSOLA(Y)) Q:'Y W !?14,"*",$$WRAP(15,33,$P(PSBSOLA(Y),U,3)_" ("_$P(PSBSOLA(Y),U,4)_")")
96 W IOINORM ; Hlight Off
97 S PSBADM=$S(PSBADMIN]"":"Admin Times: "_PSBADMIN,1:"")
98 W:PSBADM]"" $$WRAP(50,27,PSBADM)
99 S X=$S(PSBOTXT]"":PSBOTXT,1:"<None Entered>")
100 I $E(X,1)="!" S $E(X,1)=""
101 W $$WRAP(14,34,"Spec Inst: "_X),!,$TR($J("",IOM)," ","-")
102 Q
103 ;
104WRAP(X,Y,Z) ; Quick text wrap
105 F Q:'$L(Z) D
106 .W:$X>X !
107 .W:$X<X ?X
108 .I $L(Z)<Y W Z S Z="" Q
109 .F PSB=Y:-1:0 Q:$E(Z,PSB)=" "
110 .S:PSB<1 PSB=Y
111 .W $E(Z,1,PSB)
112 .S Z=$E(Z,PSB+1,255)
113 Q ""
114 ;
115FTR() ; [Extrinsic] Page footer
116 ;
117 ; Sub Module Description:
118 ; (No Description Available)
119 ;
120 I (IOSL<100) F Q:$Y>(IOSL-10) W !
121 W !,$TR($J("",IOM)," ","=")
122 S X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
123 W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
124 Q ""
125 ;
126HDR() ; Page Header
127 Q:'PSBFOHDR ""
128 D PT^PSBOHDR(DFN,.PSBHDR)
129 W !
130 W !
131 W !,?(IOM-28\2),"***** FUTURE ORDERS *****"
132 W !
133 W !,"Self",?85,"Last",?100,"Start",?110,"Stop",?120,"Verifying"
134 W !,"Med",?6,"Sched",?14,"Medication",?50,"Dose",?78,"Route",?85,"Given",?100,"Date",?110,"Date",?120,"Rph/Rn"
135 W !,?100,"@Time",?110,"@Time"
136 W !,$TR($J("",IOM)," ","-")
137 Q ""
138 ;
139BLANKS() ; [Extrinsic] Print blanks at end of printout for changes
140 Q:'$P(PSBRPT(.2),U,5) ""
141 W !
142 I $Y>(IOSL-26) W ?(IOM-42\2),"(Changes/Addendums to Orders on Next Page)" W $$FTR(),$$HDR() ; Not enough space - new page
143 I IOSL<100 F Q:$Y>(IOSL-26) W !
144 W ?(IOM-28\2),"Changes/Addendums to orders"
145 F X=1:1:4 D
146 .W !,$TR($J("",IOM)," ","-")
147 .W !!?3,"CON ___ PRN ___",?20,"Drug: ",$TR($J("",22)," ","_"),?50,"Give: ",$TR($J("",42)," ","_"),?100,"Start: _________ Stop: _________"
148 .W !?20,"Spec"
149 .W !?3,"OT ___ OC ___",?20,"Inst: ",$TR($J("",72)," ","_"),?100,"Initials: ______ Date: _________"
150 W !,$TR($J("",IOM)," ","-")
151 Q ""
152 ;
Note: See TracBrowser for help on using the repository browser.