source: EWD/ewdapps/bb/r/jjihbb.m@ 1800

Last change on this file since 1800 was 1284, checked in by Sam Habiel, 13 years ago

Added Sign-On Project, Bed Board, Tutorial, and Roll-and-Scroll emulator
File size: 8.6 KB
Line 
1jjihbb ; JJIH/SMH - Bed Board Stuff ; 9/22/11 3:27pm
2 ;;0.5;INTRACARE SPECIFIC MODIFICATIONS;;
3 ; (C) Sam Habiel
4 ; Licensed under AGPL latest
5 ;
6 ; Bed Board routine for EWD pages index.ewd and bb.ewd
7 ;
8 ; New in 0.3:
9 ; - Added a bunch of counts everywhere.
10 ;
11 ; New in 0.4:
12 ; - Added EDW and MOT fields
13 ; - Patients with no beds are included!
14 ;
15 ; New in 0.5:
16 ; - Fixed division by zero problem if db is completely unconfigured
17 ;
18init(sessid) ; Populate index.ewd with site name
19 new DIQUIET set DIQUIET=1 ; Fileman - be quiet
20 do DT^DICRW ; Set-up miniumum variables for VISTA
21 new sitename set sitename=$piece($$SITE^VASITE,"^",2)
22 set sitename=$$TITLE^XLFSTR(sitename) ; Make uppercase title case.
23 do setSessionValue^%zewdAPI("sitename",sitename,sessid)
24 quit ""
25 ;
26getbeds(sessid) ; Populate bb.ewd with bed board information
27 ;
28 ; To run this on your terminal, set debug to 1 and type: w $$getbeds^jjihbb(80)
29 new debug set debug=0 ; Make this 1 to be talkative
30 new DIQUIET set DIQUIET=1 ; Fileman - be quiet
31 do DT^DICRW ; Set-up miniumum variables for VISTA
32 ; Ask Fileman for the list of the wards, taking out inactive ones
33 ; File 42; .01 field only, "Packed Output, don't re-sort", use "B" index
34 ; Screen inactive wards out using Fileman Screen on File.
35 n wards1,err
36 D LIST^DIC(42,"","@;.01","PQ","","","","B","S D0=Y D WIN^DGPMDDCF I 'X","","wards1","err")
37 i $d(err) s $EC=",U101," ; we shouldn't ever have any messages - crash if so
38 n wards2 ; better wards!
39 m wards2=wards1("DILIST")
40 ; expected output:
41 ; wards2(0)="5^*^0^"
42 ; wards2(0,"MAP")="IEN^.01"
43 ; wards2(1,0)="15^Adolescent 2L 201-213 South"
44 ; wards2(2,0)="11^Child 2R 214-225 South"
45 ; wards2(3,0)="14^DAPA 3R 314-326"
46 ; wards2(4,0)="13^General/Adult 3L 300-313 South"
47 ; wards2(5,0)="10^Restore 1L 101-111 South"
48 ; Now, walk the beds a la ABB^DGPMRBA1
49 n wardbed ; return array
50 n i s i=0
51 for s i=$o(wards2(i)) q:'i do
52 . n wardien s wardien=$piece(wards2(i,0),"^")
53 . zwrite:debug wardien
54 . n roomien s roomien=0
55 . for s roomien=$o(^DG(405.4,"W",wardien,roomien)) q:'roomien do
56 . . zwrite:debug roomien
57 . . quit:'$d(^DG(405.4,roomien,0))
58 . . new bed set bed=$P(^(0),"^")
59 . . new admien set admien=$o(^DGPM("ARM",roomien,0))
60 . . new lodger,ptnode,edw,mot
61 . . if admien d
62 . . . set lodger=^(admien)
63 . . . set ptnode=^DGPM(admien,0) ; note naked sexy ref
64 . . . set edw=+$p($g(^("JJIH0")),"^")
65 . . . set mot=+$p($g(^("JJIH0")),"^",2)
66 . . write:debug "ptnode: "_$g(ptnode),!
67 . . write:debug "edw: "_$g(edw),!
68 . . write:debug "mot: "_$g(mot),!
69 . . ;
70 . . ; Bed Message
71 . . ; pt name^pt sex^adm date^lodger^EDW^MOT^bed oos?^bed oos msg^bed oss comment
72 . . n bedmsg
73 . . i $g(ptnode) d ; if we have a patient, that's the bed msg
74 . . . n dfn s dfn=$p(ptnode,"^",3)
75 . . . s bedmsg=$p(^DPT(dfn,0),"^",1,2) ; Patient name and sex
76 . . . ; s $p(bedmsg,"^",3)=$$FMTE^XLFDT($p(ptnode,"^")) ; Admission date
77 . . . s $p(bedmsg,"^",3)=$$DATE^TIULS($p(ptnode,"^"),"AMTH DD@HR:MIN") ; Admission date using TIU API
78 . . . s $p(bedmsg,"^",4)=$g(lodger)
79 . . . s $p(bedmsg,"^",5)=$g(edw)
80 . . . s $p(bedmsg,"^",6)=$g(mot)
81 . . d ; Out of Service Checks?
82 . . . n oos s oos=$$oos(roomien) ; 0 or 1^msg^comment
83 . . . s $p(bedmsg,"^",7,9)=oos
84 . . ;
85 . . s wardbed($piece(wards2(i,0),"^",2),bed)=bedmsg
86 ;
87 ; Loop through inpatients to find patients without a bed
88 ; Bed Message (reminder!)
89 ; pt name^pt sex^adm date^lodger^EDW^MOT^bed oos?^bed oos msg^bed oss comment
90 n i,j s (i,j)=""
91 n counter s counter=0
92 for s i=$o(^DPT("CN",i)) q:i="" for s j=$o(^DPT("CN",i,j)) q:j="" do
93 . n admien s admien=^(j) ; Patient Movement IEN stored in Index
94 . n dfn s dfn=j
95 . n bed s bed=$get(^DPT(dfn,.101))
96 . i bed'="" quit ; if bed is not empty, quit!
97 . s counter=counter+1
98 . n wardname s wardname=^DPT(dfn,.1)
99 . s wardbed(wardname,"NONE"_counter)=$p(^DPT(dfn,0),"^",1,2) ; name, sex
100 . n admdate s admdate=$P(^DGPM(admien,0),"^")
101 . s $p(wardbed(wardname,"NONE"_counter),"^",3)=$$DATE^TIULS(admdate,"AMTH DD@HR:MIN")
102 . s $p(wardbed(wardname,"NONE"_counter),"^",4)=0 ; lodger
103 . n edw s edw=+$p($g(^("JJIH0")),"^")
104 . s $p(wardbed(wardname,"NONE"_counter),"^",5)=edw
105 . n mot s mot=+$p($g(^("JJIH0")),"^",2)
106 . s $p(wardbed(wardname,"NONE"_counter),"^",6)=mot
107 ;
108 ; Loop through lodgers to find lodgers without a bed
109 ; Bed Message (reminder!)
110 ; pt name^pt sex^adm date^lodger^EDW^MOT^bed oos?^bed oos msg^bed oss comment
111 n i,j s (i,j)=""
112 for s i=$o(^DPT("LD",i)) q:i="" for s j=$o(^DPT("LD",i,j)) q:j="" do
113 . n admien s admien=^(j) ; Patient Movement IEN stored in Index
114 . n dfn s dfn=j
115 . n bed s bed=$get(^DPT(dfn,.108))
116 . i bed'="" quit ; if bed is not empty, quit!
117 . s counter=counter+1
118 . n wardname s wardname=^DPT(dfn,.107)
119 . s wardbed(wardname,"NONE"_counter)=$p(^DPT(dfn,0),"^",1,2) ; name, sex
120 . n admdate s admdate=$P(^DGPM(admien,0),"^")
121 . s $p(wardbed(wardname,"NONE"_counter),"^",3)=$$DATE^TIULS(admdate,"AMTH DD@HR:MIN")
122 . s $p(wardbed(wardname,"NONE"_counter),"^",4)=1 ; lodger
123 . n edw s edw=+$p($g(^("JJIH0")),"^")
124 . s $p(wardbed(wardname,"NONE"_counter),"^",5)=edw
125 . n mot s mot=+$p($g(^("JJIH0")),"^",2)
126 . s $p(wardbed(wardname,"NONE"_counter),"^",6)=mot
127 ;
128 ; Now loop through the results and count beds, males, and females
129 ; Result will be in wardbed("ward name")=
130 ; occ beds/total^occmale/maletotal^occfemale/femaletotal^oos^
131 ; emptymale/emptyfemale/emptytotal
132 n i s i="" n j s j="" ; i loops through wards, j beds
133 f s i=$o(wardbed(i)) q:i="" d
134 . n nBed,nMale,nFemale,nOOS,nMaleBed,nFemaleBed,nEmptyMaleBed,nEmptyFemaleBed
135 . s (nBed,nMale,nFemale,nOOS,nMaleBed,nFemaleBed,nEmptyMaleBed,nEmptyFemaleBed)=0
136 . ;
137 . f s j=$o(wardbed(i,j)) q:j="" d
138 . . n node s node=wardbed(i,j)
139 . . i +j s nBed=nBed+1 ; if bed is numeric, then count it as a bed. If NONE, won't count
140 . . i $p(j,"-",3)["M" s nMaleBed=nMaleBed+1 ; Male Bed
141 . . i $p(j,"-",3)["F" s nFemaleBed=nFemaleBed+1 ; Female Bed
142 . . i $p(j,"-",3)["M"&($p(node,"^")="") s nEmptyMaleBed=nEmptyMaleBed+1 ; Empty Male Bed
143 . . i $p(j,"-",3)["F"&($p(node,"^")="") s nEmptyFemaleBed=nEmptyFemaleBed+1 ; Empty Female Bed
144 . . i $p(node,"^",2)="M" s nMale=nMale+1 ; Male Patient
145 . . i $p(node,"^",2)="F" s nFemale=nFemale+1 ; Female Patient
146 . . i $p(node,"^",7)="1" s nOOS=nOOS+1 ; Out of Service Bed
147 . ;
148 . n nOccupied s nOccupied=nMale+nFemale
149 . n nAvailBed s nAvailBed=nBed-nOccupied
150 . n % s %="/"
151 . s wardbed(i)=nOccupied_%_nBed_U_nMale_%_nMaleBed_U_nFemale_%_nFemaleBed_U_nOOS_U_nEmptyMaleBed_%_nEmptyFemaleBed_%_nAvailBed
152 ;
153 ; Now, loop again and count the counts for a total census.
154 n i s i=""
155 n tBed,tMale,tFemale,tOOS s (tBed,tMale,tFemale,tOOS)=0 ; Totals
156 f s i=$o(wardbed(i)) q:i="" d
157 . n node s node=wardbed(i)
158 . n nBed s nBed=$p($p(wardbed(i),"^"),"/",2)
159 . n nMale s nMale=$p(wardbed(i),"^",2)
160 . n nFemale s nFemale=$p(wardbed(i),"^",3)
161 . n nOOS s nOOS=$p(wardbed(i),"^",4)
162 . s tBed=tBed+nBed
163 . s tMale=tMale+nMale
164 . s tFemale=tFemale+nFemale
165 . s tOOS=tOOS+nOOS
166 ; done
167 ;
168 ; Set the totals at the top top node in the following format
169 ; wardbed=beds^males^females^empty beds^occupancy %
170 n tEmptyBed s tEmptyBed=tBed-(tMale+tFemale+tOOS) ; Empty beds
171 ;
172 n %occupancy
173 ; Prevent div by zero error if beds are not there!!!
174 i tBed=0 s %occupancy=0
175 e s %occupancy=(1-(tEmptyBed/tBed))*100 ; Reader: math quiz for you
176 s %occupancy=$fn(%occupancy,"",0) ; Round up to 0 decimal places
177 ;
178 s wardbed=tBed_U_tMale_U_tFemale_U_tEmptyBed_U_%occupancy
179 ;
180 ; Put it in the EWD Session
181 do clearSessionArray^%zewdAPI("wardbed",sessid)
182 do mergeArrayToSession^%zewdAPI(.wardbed,"wardbed",sessid)
183 ;
184 zwrite:debug wardbed
185 quit ""
186 ;
187oos(bedien) ; Is the bed out of service ; Public $$
188 ; Input: bedien
189 ; Output: 0 -> not out of service -> Active
190 ; 1^reason -> Out of service and reason
191 ;
192 ; First OOS date in the inverse index is the latest
193 N X S X=$O(^DG(405.4,bedien,"I","AINV",0))
194 I 'X Q 0 ; if none, quit
195 ;
196 S X=$O(^(+X,0)) ; Then get ifn
197 Q:'$d(^DG(405.4,bedien,"I",+X,0)) 0 ; confirm that entry exists
198 ;
199 N DGND S DGND=^(0) ; Out of Service Node
200 N OOSD S OOSD=$P(DGND,"^") ; Out of Service Date
201 N OOSR S OOSR=$P(DGND,"^",4) ; Out of Service Restore
202 N NOW S NOW=$$NOW^XLFDT() ; Now
203 ;
204 I OOSD>NOW Q 0 ; If OOSD in future, bed is active
205 ;
206 ; at this point, OOSD is now or in the past.
207 ; Is there a restore date less than today's date? if yes, bed is active
208 I OOSR'="",OOSR<NOW Q 0
209 ;
210 ; at this point, we are sure that the bed is inactive.
211 N reasonifn s reasonifn=$p(DGND,"^",2)
212 N comment s comment=$p(DGND,"^",3)
213 Q 1_"^"_$$GET1^DIQ(405.5,reasonifn,.01)_"^"_comment
Note: See TracBrowser for help on using the repository browser.