source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/CRHDUT.m@ 1800

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

initial load of WorldVistAEHR
File size: 8.1 KB
RevLine 
[613]1CRHDUT ; CAIRO/CLC - GET THE PATIENT DATA ELEMENTS FOR HANDOFF LIST ;5/13/08 05:19
2 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
3 ;=================================================================
4ALG(CRHDRTN0,CRHDSTR) ; Allergies
5 N CRHDTNUM
6 S CRHDTRG="CRHDRTN0"
7 S DFN=+CRHDSTR
8 S CRHDNUM=$P(CRHDSTR,U,2)
9 S CRHDHDR=$P(CRHDSTR,U,3)
10 K @CRHDTRG,CRHDRTN
11 N CRHDX
12 S CRHDNUM=CRHDNUM+1,CRHDTNUM=CRHDNUM
13 S CRHDNUM=$G(CRHDNUM)+1
14 S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM)="Allergies: "
15 D LIST^ORQQAL(.CRHDRTN,DFN)
16 S CRHDX=0
17 F S CRHDX=$O(CRHDRTN(CRHDX)) Q:'CRHDX D
18 .S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):12,1:1))_$P(CRHDRTN(CRHDX),"^",2)
19 . S CRHDNUM=CRHDNUM+1
20 S @CRHDTRG@(CRHDTNUM)=CRHDNUM-1
21 Q
22ACTMED(CRHDRTN,CRHDSTR) ;Active Medications
23 ;CRHDRTN: Target array
24 ;CRHDCAT: I-Inpatient Meds
25 ; O-Outpatient Meds
26 ; B-Both
27 ;CRHDIV: 0 - Do not include IV
28 ; 1 - include IV
29 ;CRHDNUM: next number in results array
30 ;CRHDHDR: include section heading
31 ;CRHDDET: details, 1-include the sig, 0-exclude sig
32 ;CRHDLEN: length to return in chars. Defaults to 16 chars.
33 N CRHDUD,CRHDV,CRHDX2,CRHDC,CRHDMEDS,CRHDRN,DFN,CRHDCAT,CRHDI,CRHDN,CRHDP1,CRHDP2
34 N CRHDIV,CRHDNUM,CRHDHDR,CRHDDET,CRHDFG,CRHDLEN,CRHDTNUM,CRHDMCTR,CRHDTX
35 S DFN=+CRHDSTR
36 S CRHDCAT=$P(CRHDSTR,U,2)
37 I CRHDCAT="" S CRHDCAT="I"
38 S CRHDIV=$P(CRHDSTR,U,3)
39 S CRHDNUM=$P(CRHDSTR,U,4)
40 S CRHDHDR=$P(CRHDSTR,U,5)
41 S CRHDDET=$P(CRHDSTR,U,6)
42 S CRHDLEN=$P(CRHDSTR,U,7)
43 I 'CRHDLEN S CRHDLEN=16
44 S CRHDTRG="CRHDRTN"
45 K @CRHDTRG
46 S CRHDMCTR=0
47 S CRHDNUM=CRHDNUM+1,CRHDTNUM=CRHDNUM
48 S CRHDNUM=$G(CRHDNUM)+1
49 S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM)="Meds: "
50 I CRHDCAT="O"!('CRHDDET) D NODETAM^CRHD2(.CRHDMEDS,DFN,CRHDCAT),NDOUT S @CRHDTRG@(CRHDTNUM)=CRHDNUM-1 Q
51 I CRHDDET S CRHDX=$$PSGI^CRHDAM(.CRHDMEDS,DFN) D DOUT
52 S @CRHDTRG@(CRHDTNUM)=CRHDNUM-1
53 Q
54NDOUT ;no details output
55 S CRHDP2=" S CRHDN="""""_" F S CRHDN=$O(CRHDMEDS(CRHDI,CRHDN)) Q:'CRHDN D AOUTPUT"
56 I CRHDCAT="I" D
57 .S CRHDP1="F CRHDI=""U"""
58 .I CRHDIV S CRHDP1=CRHDP1_","_"""V"""
59 I CRHDCAT="O" D
60 .S CRHDP1="F CRHDI=""N"""_","_"""R"""
61 S CRHDP1=CRHDP1_CRHDP2
62 X CRHDP1
63 Q
64AOUTPUT ;
65 S CRHDNUM=CRHDNUM+1
66 ;I HDR S @TRG@(CRHDNUM)="Medications",NUM=NUM+1,HDR=0
67 ;S @CRHDTRG@(CRHDNUM)=$E($G(CRHDMEDS(CRHDI,CRHDN)),1,CRHDLEN)
68 S CRHDMCTR=CRHDMCTR+1,@CRHDTRG@(CRHDNUM)=CRHDMCTR_"."_$E($G(CRHDMEDS(CRHDI,CRHDN)),1,CRHDLEN)
69 Q
70DOUT ;
71 S (CRHDX2,CRHDFG,CRHDMCTR)=0
72 F S CRHDX2=$O(CRHDMEDS(CRHDX2)) Q:'CRHDX2!(CRHDFG) D
73 .S CRHDTX=""
74 .S CRHDC=$P(CRHDMEDS(CRHDX2),"^",2)
75 .Q:CRHDC=""
76 .I CRHDHDR S CRHDNUM=CRHDNUM+1,@CRHDTRG@(CRHDNUM)="Inpatient Meds: ",CRHDNUM=CRHDNUM+1,CRHDHDR=0
77IV .I 'CRHDIV&(CRHDC["IV DOSE") S CRHDFG=1 Q
78 .I CRHDDET D
79 ..I (CRHDC["=UNIT DOSE=")!(CRHDC["=IV DOSE=") S @CRHDTRG@(CRHDNUM)=$E(CRHDC,1,CRHDLEN)
80 ..E S CRHDMCTR=CRHDMCTR+1,@CRHDTRG@(CRHDNUM)=CRHDMCTR_"."_$E(CRHDC,1,CRHDLEN)
81 .I 'CRHDDET S @CRHDTRG@(CRHDNUM)=$E(CRHDC,1,CRHDLEN)
82 .S CRHDNUM=CRHDNUM+1
83 Q
84CONSULT(CRHDRTN,CRHDSTR) ;consults orders - call from cprs
85 ;DFN,FILTERS,GROUPS,DTFROM,DTTHRU,EVENT
86 N CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE,CRHDGRP
87 N CRHDLEN,CHRDHDR,CRHDSTS,CRHDILST,DFN
88 S DFN=+CRHDSTR
89 S CRHDSTS=$P(CRHDSTR,U,2)
90 S CRHDNUM=$P(CRHDSTR,U,3)
91 S CRHDHDR=$P(CRHDSTR,U,4)
92 S CRHDLEN=$P(CRHDSTR,U,5)
93 I 'CRHDLEN S CRHDLEN=20
94 S CRHDTRG="CRHDRTN"
95 K @CRHDTRG
96 S CRHDGRP=$O(^ORD(100.98,"B","CONSULTS",0))
97 ;D AGET^ORWORR(.CRHDY,DFN,"2^0",11,0,0,"")
98 D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
99 M CRHDILST=@CRHDY
100 K CRHDILST(.1)
101 D DETORD("CRHDRTN",.CRHDLST,.CRHDILST,"",CRHDLEN)
102 Q
103IMAGING(CRHDRTN,CRHDSTR) ;Radiology orders - call from cprs
104 ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
105 N CRHDY,CRHDILST,ORYD,CRHDLST,X,CRHDLEN
106 N D1,CRHDATE,DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDTRG,CRHDGRP
107 S DFN=+CRHDSTR
108 S CRHDSTS=$P(CRHDSTR,U,2)
109 S CRHDNUM=$P(CRHDSTR,U,3)
110 S CRHDHDR=$P(CRHDSTR,U,4)
111 S CRHDLEN=$P(CRHDSTR,U,5)
112 I 'CRHDLEN S CRHDLEN=20
113 S CRHDTRG="CRHDRTN"
114 K @CRHDTRG
115 S CRHDGRP=$O(^ORD(100.98,"B","IMAGING",0))
116 ;D AGET^ORWORR(.CRHDY,DFN,"2^0",34,0,0,"")
117 D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
118 M CRHDILST=@CRHDY
119 K CRHDILST(.1)
120 D DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
121 Q
122LABS(CRHDRTN,CRHDSTR) ;LABS orders - call from cprs
123 ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
124 N CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE
125 N DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDLEN,CRHDTRG
126 S DFN=+CRHDSTR
127 S CRHDSTS=$P(CRHDSTR,U,2)
128 S CRHDNUM=$P(CRHDSTR,U,3)
129 S CRHDHDR=$P(CRHDSTR,U,4)
130 S CRHDLEN=$P(CRHDSTR,U,5)
131 I 'CRHDLEN S CRHDLEN=20
132 S CRHDTRG="CRHDRTN"
133 K @CRHDTRG
134 S CRHDGRP=$O(^ORD(100.98,"B","LABORATORY",0))
135 ;D AGET^ORWORR(.CRHDY,DFN,"2^0",5,0,0,"")
136 D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
137 M CRHDILST=@CRHDY
138 K CRHDILST(.1)
139 D DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
140 Q
141PROC(CRHDRTN,CRHDSTR) ;,DFN,CRHDSTS,CRHDNUM,CRHDHDR) ;Procedures orders - call from cprs
142 ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
143 N CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE
144 N DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDGRP,CRHDLEN,CRHDTRG
145 S DFN=+CRHDSTR
146 S CRHDSTS=$P(CRHDSTR,U,2)
147 S CRHDNUM=$P(CRHDSTR,U,3)
148 S CRHDHDR=$P(CRHDSTR,U,4)
149 S CRHDLEN=$P(CRHDSTR,U,5)
150 I 'CRHDLEN S CRHDLEN=20
151 S CRHDTRG="CRHDRTN"
152 K @CRHDTRG
153 S CRHDGRP=$O(^ORD(100.98,"B","PROCEDURES",0))
154 ;D AGET^ORWORR(.CRHDY,DFN,"2^0",43,0,0,"")
155 D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
156 M CRHDILST=@CRHDY
157 K CRHDILST(.1)
158 D DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
159 Q
160DETORD(CRHDTRG,CRHDRLST,CRHDILST,CRHDHEAD,CRHDLEN) ;
161 N ORYD,CRHDSTS,CRHDD1,CRHDATE,CRHDX
162 S ORYD=""
163 D GET4LST^ORWORR(.CRHDRLST,.CRHDILST)
164 S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM,0)=CRHDHEAD_": "
165 S CRHDX=""
166 F S CRHDX=$O(CRHDLST(CRHDX)) Q:'CRHDX D
167 . S CRHDD1=$P(CRHDLST(CRHDX),"^",3)
168 . I $E(CRHDLST(CRHDX),1)="~" D
169 . .S CRHDD1=$P(CRHDLST(CRHDX),"^",3)
170 . .S CRHDSTS=$P(CRHDLST(CRHDX),"^",10)
171 . .S CRHDATE=$$FMTE^XLFDT(CRHDD1,2)
172 . .S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):16,1:1))_$P(CRHDATE,"@",1)
173 . I $E(CRHDLST(CRHDX),1)="t" D
174 . .S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):16,1:1))_" "_$E(CRHDLST(CRHDX),2,$L(CRHDLST(CRHDX)))_" ("_$P($G(^ORD(100.01,+CRHDSTS,0)),"^",1)_")"
175 . .S @CRHDTRG@(CRHDNUM)=$E(@CRHDTRG@(CRHDNUM),1,CRHDLEN),CRHDNUM=CRHDNUM+1
176 Q
177PROB(CRHDRTNA,CRHDSTR) ;DFN,NUM,CRHDHDR) ;
178 ;Target array ^TMP("CRHD_PROB_DATA",$J)
179 N CRHDRTN,X,DFN,CRHDNUM,CRHDHDR,CRHDTRG
180 S DFN=+CRHDSTR
181 S CRHDNUM=$P(CRHDSTR,U,2)
182 S CRHDHDR=$P(CRHDSTR,U,3)
183 S CRHDTRG="^TMP(""CRHD_PROB_DATA"",$J)"
184 K @CRHDTRG
185 S CRHDNUM=$G(CRHDNUM)+1
186 S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM,0)="Problem List: "
187 D LIST^ORQQPL(.CRHDRTN,DFN,"A")
188 S CRHDX=0
189 F S CRHDX=$O(CRHDRTN(CRHDX)) Q:'CRHDX D
190 . S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):15,1:1))_$P(CRHDRTN(X),"^",2)
191 . S CRHDNUM=CRHDNUM+1
192 ;S @CRHDTRG@(CRHDNUM)=""
193 Q
194RECNTLAB(CRHDROOT,DFN,CRHDNUM,CRHDHDR) ;
195 ;(CRHDY,DFN,CRHDATE1,DIR,FORMAT)
196 D INTERIMG^ORWLRR(.CRHDY,DFN,$$DT^XLFDT_".2359",1,"")
197 Q
198SPACE(CRHDX1,CRHDX) ;
199 N CRHDY,CRHDY1
200 S CRHDY1="",CRHDY=CRHDX-$L(CRHDX1)
201 S $P(CRHDY1," ",CRHDY)=""
202 Q CRHDY1
203PARAM(CRHDW,CRHDX) ;
204 Q $$GET^XPAR(CRHDW,CRHDX,1,"I")
205 ;
206PTSTS(DFN) ;Display current patient status
207 N CRHDGPMV,NOW,NOWI,X,Y,%,%H,%I,CRHDA,E,CRHDDGX,VAIP,VAX,VAZ,VAZ2
208 D NOW^%DTC S (VAX("DAT"),NOW)=%,NOWI=9999999.999999-%
209 D LAST^VADPT3
210 S CRHDGPMV(1)=$S($D(VAIP("E")):VAIP("E"),1:E) ;use ifn of last mvt from VADPT cal
211 S CRHDDGX=$G(^DGPM(+CRHDGPMV(1),0)),CRHDGPMV(2)=$P(CRHDDGX,"^",2),CRHDGPMV(4)=$P(CRHDDGX,"^",18)
212 S CRHDA=$S("^3^5^"[("^"_+CRHDGPMV(2)_"^"):0,1:+CRHDGPMV(2))
213 Q $S('CRHDA:"IN",1:"")_"ACTIVE "_$S("^4^5^"[("^"_+CRHDGPMV(2)_"^"):"LODGER",1:"INPATIENT")
214DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
215 N CRHDPAR,CRHDSRV,CRHDTEAM
216 S CRHDTEAM=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT TEAM",1,"I")
217 S CRHDSRV=$$GET1^DIQ(200,DUZ_",",29,"E")
218 S CRHDPAR="USR.`"_DUZ
219 D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
220 I ('CRHDNRTT)&($G(CRHDTEAM)>0) S CRHDPAR="OTL.`"_+CRHDTEAM D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
221 I ('CRHDNRTT)&($G(CRHDSRV)'="") S CRHDPAR="SRV."_CRHDSRV D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
222 I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
223 I 'CRHDNRTT S CRHDPAR="DIV.`"_+CRHDDIV D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
224 Q
Note: See TracBrowser for help on using the repository browser.