source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOMV.m@ 785

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1PSBOMV ;BIRMINGHAM/EFC-BCMA UNIT DOSE VIRTUAL DUE LIST FUNCTIONS ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
3 ;
4 ; Reference/IA
5 ; ^DPT/10035
6 ; ^NURSF(211.4/1409
7 ;
8EN ;
9 N CNT,PSBHDR,PSBPT,PSBINDX,DFN,PSBY,PSBSORT,PSBPRINT,PSBDT,PSBEV,PSBLOG,PSBPRCX,PSBRB,PSBSTOP,PSBSTRT,PSBTIME,PSBWLF,PSBWRD,PSBWRDA,PSBX,PSBY,PSBXX
10 ;
11 K ^TMP("PSBO",$J)
12 S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)
13 S PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
14 S CNT=0,PSBPRINT=$P($G(PSBRPT(.1)),U)
15 I PSBPRINT="P" S PSBPT=$P(PSBRPT(.1),U,2)
16 I PSBPRINT="W" S PSBSORT=$P($G(PSBRPT(.1)),U,5),PSBWRD=$P(PSBRPT(.1),U,3) Q:'PSBWRD D WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA)
17 ;
18RANGE ;Locate data between date range.
19 S PSBX=PSBSTRT F S PSBX=$O(^PSB(53.78,"ADT",PSBX)) Q:'PSBX!(PSBX>PSBSTOP) D
20 .F PSBY=0:0 S PSBY=$O(^PSB(53.78,"ADT",PSBX,PSBY)) Q:'PSBY D
21 ..S DFN=+^PSB(53.78,PSBY,0),PSBWLF=$P($G(^(0)),U,9),PSBTIME=$P($G(^(0)),U,4),PSBLOG=$P($G(^(0)),U,8)
22CHECK ..;Ward IEN must exist in Ward Field # 9.
23 ..Q:'$G(PSBWLF)
24 ..Q:'$G(PSBLOG)
25 ..I $G(PSBTIME)=$P($G(^PSB(53.79,PSBLOG,0)),U,6),$P($G(^PSB(53.79,PSBLOG,0)),U,9)="RM" Q
26 ..;Quit if Ward IEN is not in Nurse Location file.
27 ..I PSBPRINT="W",'$O(^NURSF(211.4,"C",PSBWLF,PSBWRD,0)) Q
28 ..;Compare date/time and Quit if order status set to Remove.
29 ..;
30BUILD ..I $G(PSBSORT)'="B" S ^TMP("PSBO",$J,DFN,PSBX,PSBY)=""
31 ..I PSBPRINT="P",DFN=PSBPT S ^TMP("PSBO",$J,"B",$P(^DPT(DFN,0),U),DFN)="" Q
32 ..S ^TMP("PSBO",$J,DFN,0)=^DPT(DFN,0)
33 ..I PSBPRINT="W" D SORTING
34 ;
35BYWDPT ;Print by Ward and Sort by Patient.
36 I $G(PSBPRINT)="W",$G(PSBSORT)'="B" D
37 .;Print report by the selected ward name.
38 .W $$WRDHDR()
39 .S PSBINDX=""
40 .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
41 ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
42 ...W:$Y>(IOSL-10) $$WRDHDR()
43 ...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,DFN,PSBDT)) Q:'PSBDT D
44 ....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,DFN,PSBDT,PSBY)) Q:'PSBY D
45 .....D EVENTS ;Set Total Number of Events
46 .....S PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
47 .....W !,PSBRB
48 .....W ?20,$P(^TMP("PSBO",$J,DFN,0),U,1)
49 .....W ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
50 .....W ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
51 .....W ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
52 .....W ?102,$$GET1^DIQ(53.78,PSBY_",",.07)
53 .....W ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
54 .....D VCOM ;Print Ward and Comments from Med Log.
55 .....W !?52
56 .W !! D EVEPRNT
57 ;
58BYWDRB ;Print by Ward and Sort by Room and Bed.
59 I $G(PSBPRINT)="W",$G(PSBSORT)="B" D
60 .;Print report by the selected ward name.
61 .W $$WRDHDR()
62 .S PSBINDX=""
63 .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
64 ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
65 ...W:$Y>(IOSL-10) $$WRDHDR()
66 ...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBDT)) Q:'PSBDT D
67 ....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBDT,PSBY)) Q:'PSBY D
68 .....D EVENTS ;Set Total Number of Events
69 .....S PSBRB=$$GET1^DIQ(53.78,PSBY_",",.02)
70 .....W !,PSBRB
71 .....W ?20,$P(^TMP("PSBO",$J,DFN,0),U,1)
72 .....W ?48,$$GET1^DIQ(53.78,PSBY_",",.04)
73 .....W ?75,$$GET1^DIQ(53.78,PSBY_",",.05)
74 .....W ?95,$$GET1^DIQ(53.78,PSBY_",",.06)
75 .....W ?102,$$GET1^DIQ(53.78,PSBY_",",.07)
76 .....W ?102,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
77 .....D VCOM ;Print Ward and Comments from Med Log.
78 .....W !?52
79 .W !! D EVEPRNT
80 ;
81BYDFN ;Print by Patient.
82 D:$G(PSBPRINT)="P"
83 .W $$PTHDR()
84 .S PSBINDX=""
85 .F S PSBINDX=$O(^TMP("PSBO",$J,"B",PSBINDX)) Q:PSBINDX="" D
86 ..F DFN=0:0 S DFN=$O(^TMP("PSBO",$J,"B",PSBINDX,DFN)) Q:'DFN D
87 ...W:$Y>(IOSL-10) $$PTHDR()
88 ...F PSBDT=0:0 S PSBDT=$O(^TMP("PSBO",$J,DFN,PSBDT)) Q:'PSBDT D
89 ....F PSBY=0:0 S PSBY=$O(^TMP("PSBO",$J,DFN,PSBDT,PSBY)) Q:'PSBY D
90 .....D EVENTS ;Set Total Number of Events
91 .....W !,$$GET1^DIQ(53.78,PSBY_",",.04)
92 .....W ?23,$$GET1^DIQ(53.78,PSBY_",",.05)
93 .....W ?43,$$GET1^DIQ(53.78,PSBY_",",.06)
94 .....W ?50,$$GET1^DIQ(53.78,PSBY_",",.07)
95 .....W ?50,$$GET1^DIQ(53.78,PSBY_",","MED LOG PTR:ADMINISTRATION MEDICATION")
96 .....D VCOM ;Print Ward and Comments from Med Log.
97 .W !! D EVEPRNT
98 .W $$PTFTR^PSBOHDR()
99 Q
100 ;
101WRDHDR() ;
102 S PSBHDR(1)="MEDICATION VARIANCE LOG"
103 D WARD^PSBOHDR(PSBWRD,.PSBHDR)
104 W !,"Rm-Bed",?20,"Patient Name",?48,"Event Date/Time",?75,"Event",?95,"Var",?102,"Medication",!,$TR($J("",IOM)," ","-")
105 Q ""
106 ;
107PTHDR() ;
108 S PSBHDR(1)="MEDICATION VARIANCE LOG"
109 D PT^PSBOHDR(PSBDFN,.PSBHDR)
110 W !,"Event Date/Time",?23,"Event",?43,"Var",?50,"Medication",!,$TR($J("",IOM)," ","-")
111 Q ""
112 ;
113VCOM ;Print Ward and Comments from Med Log on Variance Report.
114 N PSBCOM,PSBML,Y
115 Q:'$P($G(^PSB(53.78,PSBY,0)),"^",8) S PSBML=$P(^(0),"^",8)
116 I $P(PSBRPT(.1),U)="P" W !,?23,"Ward: ",?34 D
117 .I $P($G(^PSB(53.79,PSBML,0)),U,2)="" W "<No Ward>" Q
118 .W $P($G(^PSB(53.79,PSBML,0)),U,2)
119 W !,?23,"Comments: ",?34 I '$O(^PSB(53.79,PSBML,.3,0)) W "<No Comments>" Q
120 F PSBCOM=0:0 S PSBCOM=$O(^PSB(53.79,PSBML,.3,PSBCOM)) Q:'PSBCOM D
121 .W:$X>34 !?34
122 .S Y=$P(^PSB(53.79,PSBML,.3,PSBCOM,0),U,3)+.0000001
123 .W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)," ",$E(Y,9,10),":",$E(Y,11,12),?50,"By: ",$$GET1^DIQ(53.793,PSBCOM_","_PSBML_",","ENTERED BY:INITIAL"),$$WRAP^PSBO(60,75,$P(^PSB(53.79,PSBML,.3,PSBCOM,0),U,1))
124 Q
125 ;
126EVENTS ;Record total number of events.
127 S PSBEV=$P($G(^PSB(53.78,PSBY,0)),U,5) Q:'$G(PSBEV)
128 S ^TMP("PSBO",$J,"EVENTS",PSBEV,0)=$P($G(^TMP("PSBO",$J,"EVENTS",PSBEV,0)),U)+1
129 S CNT=CNT+1,^TMP("PSBO",$J,"EVENTSTOT",0)=CNT
130 Q
131EVEPRNT ;Display Total and Percentage of Events.
132 ;
133 Q:'$D(^TMP("PSBO",$J,"EVENTSTOT")) ;Quit if there are no events
134 W !,"Total Number of Events for the reporting period is: "_$P(^TMP("PSBO",$J,"EVENTSTOT",0),U)_".",!
135 F PSBXX=0:0 S PSBXX=$O(^TMP("PSBO",$J,"EVENTS",PSBXX)) Q:'PSBXX D
136 .W !,"Total number of "_$$EXTERNAL^DILFD(53.78,.05,"",PSBXX)_" events is "_$P($G(^TMP("PSBO",$J,"EVENTS",PSBXX,0)),U)_"."
137 .S PSBPRCX=$E($FN($P(^TMP("PSBO",$J,"EVENTS",PSBXX,0),U)/$P(^TMP("PSBO",$J,"EVENTSTOT",0),U),"",2),3,4)
138 .W !,"Percentage of Total Events: "_$S(PSBPRCX="00":"100",1:PSBPRCX)_"%",!
139 Q
140 ;
141SORTING ;Sort by Patient or Room and Bed Information
142 ;
143 I $G(PSBSORT)="P"!($G(PSBSORT)="") S PSBINDX=$P(^DPT(DFN,0),U),^TMP("PSBO",$J,"B",PSBINDX,DFN)="" Q
144 I $G(PSBSORT)="B" S PSBINDX=$P($G(^PSB(53.78,+PSBY,0)),U,2) S:PSBINDX="" PSBINDX="** NO ROOM/BED **" S ^TMP("PSBO",$J,"B",PSBINDX,DFN,PSBX,PSBY)=""
145 Q
Note: See TracBrowser for help on using the repository browser.