CRHDUT ; CAIRO/CLC - GET THE PATIENT DATA ELEMENTS FOR HANDOFF LIST ;5/13/08  05:19
 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
 ;=================================================================
ALG(CRHDRTN0,CRHDSTR) ; Allergies
 
CRHDTNUM
 
CRHDTRG="CRHDRTN0"
 
DFN=+CRHDSTR
 
CRHDNUM=$P(CRHDSTR,U,2)
 
CRHDHDR=$P(CRHDSTR,U,3)
 
@CRHDTRG,CRHDRTN
 
CRHDX
 
CRHDNUM=CRHDNUM+1,CRHDTNUM=CRHDNUM
 
CRHDNUM=$G(CRHDNUM)+1
 
S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM)="Allergies: "
 
LIST^ORQQAL(.CRHDRTN,DFN)
 
CRHDX=0
 
F  S CRHDX=$O(CRHDRTN(CRHDX)) Q:'CRHDX  D
 
.@CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):12,1:1))_$P(CRHDRTN(CRHDX),"^",2)
 . 
CRHDNUM=CRHDNUM+1
 
@CRHDTRG@(CRHDTNUM)=CRHDNUM-1
 
Q
ACTMED(CRHDRTN,CRHDSTR) ;Active Medications
 ;CRHDRTN: Target array
 ;CRHDCAT: I-Inpatient Meds
 ;         O-Outpatient Meds
 ;         B-Both
 ;CRHDIV:  0 - Do not include IV
 ;         1 - include IV
 ;CRHDNUM: next number in results array
 ;CRHDHDR: include section heading
 ;CRHDDET: details, 1-include the sig, 0-exclude sig
 ;CRHDLEN: length to return in chars. Defaults to 16 chars.
 
CRHDUD,CRHDV,CRHDX2,CRHDC,CRHDMEDS,CRHDRN,DFN,CRHDCAT,CRHDI,CRHDN,CRHDP1,CRHDP2
 
CRHDIV,CRHDNUM,CRHDHDR,CRHDDET,CRHDFG,CRHDLEN,CRHDTNUM,CRHDMCTR,CRHDTX
 
DFN=+CRHDSTR
 
CRHDCAT=$P(CRHDSTR,U,2)
 
CRHDCAT="" CRHDCAT="I"
 
CRHDIV=$P(CRHDSTR,U,3)
 
CRHDNUM=$P(CRHDSTR,U,4)
 
CRHDHDR=$P(CRHDSTR,U,5)
 
CRHDDET=$P(CRHDSTR,U,6)
 
CRHDLEN=$P(CRHDSTR,U,7)
 
'CRHDLEN CRHDLEN=16
 
CRHDTRG="CRHDRTN"
 
@CRHDTRG
 
CRHDMCTR=0
 
CRHDNUM=CRHDNUM+1,CRHDTNUM=CRHDNUM
 
CRHDNUM=$G(CRHDNUM)+1
 
S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM)="Meds: "
 
CRHDCAT="O"!('CRHDDETNODETAM^CRHD2(.CRHDMEDS,DFN,CRHDCAT),NDOUT @CRHDTRG@(CRHDTNUM)=CRHDNUM-1 Q
 I 
CRHDDET CRHDX=$$PSGI^CRHDAM(.CRHDMEDS,DFNDOUT
 
@CRHDTRG@(CRHDTNUM)=CRHDNUM-1
 
Q
NDOUT ;no details output
 
CRHDP2=" S CRHDN="""""_" F  S CRHDN=$O(CRHDMEDS(CRHDI,CRHDN)) Q:'CRHDN  D AOUTPUT"
 
CRHDCAT="I" D
 
.CRHDP1="F CRHDI=""U"""
 
.CRHDIV CRHDP1=CRHDP1_","_"""V"""
 
CRHDCAT="O" D
 
.CRHDP1="F CRHDI=""N"""_","_"""R"""
 
CRHDP1=CRHDP1_CRHDP2
 
CRHDP1
 
Q
AOUTPUT ;
 
CRHDNUM=CRHDNUM+1
 
;I HDR S @TRG@(CRHDNUM)="Medications",NUM=NUM+1,HDR=0
 ;S @CRHDTRG@(CRHDNUM)=$E($G(CRHDMEDS(CRHDI,CRHDN)),1,CRHDLEN)
 
CRHDMCTR=CRHDMCTR+1,@CRHDTRG@(CRHDNUM)=CRHDMCTR_"."_$E($G(CRHDMEDS(CRHDI,CRHDN)),1,CRHDLEN)
 
Q
DOUT ;
 
(CRHDX2,CRHDFG,CRHDMCTR)=0
 
F  S CRHDX2=$O(CRHDMEDS(CRHDX2)) Q:'CRHDX2!(CRHDFG)  D
 
.CRHDTX=""
 
.CRHDC=$P(CRHDMEDS(CRHDX2),"^",2)
 .
Q:CRHDC=""
 
.CRHDHDR CRHDNUM=CRHDNUM+1,@CRHDTRG@(CRHDNUM)="Inpatient Meds: ",CRHDNUM=CRHDNUM+1,CRHDHDR=0
IV .'CRHDIV&(CRHDC["IV DOSE"CRHDFG=1 Q
 
.CRHDDET D
 
..(CRHDC["=UNIT DOSE=")!(CRHDC["=IV DOSE="@CRHDTRG@(CRHDNUM)=$E(CRHDC,1,CRHDLEN)
 ..
E  S CRHDMCTR=CRHDMCTR+1,@CRHDTRG@(CRHDNUM)=CRHDMCTR_"."_$E(CRHDC,1,CRHDLEN)
 .
'CRHDDET @CRHDTRG@(CRHDNUM)=$E(CRHDC,1,CRHDLEN)
 .
CRHDNUM=CRHDNUM+1
 
Q
CONSULT(CRHDRTN,CRHDSTR) ;consults orders - call from cprs
 ;DFN,FILTERS,GROUPS,DTFROM,DTTHRU,EVENT
 
CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE,CRHDGRP
 
CRHDLEN,CHRDHDR,CRHDSTS,CRHDILST,DFN
 
DFN=+CRHDSTR
 
CRHDSTS=$P(CRHDSTR,U,2)
 
CRHDNUM=$P(CRHDSTR,U,3)
 
CRHDHDR=$P(CRHDSTR,U,4)
 
CRHDLEN=$P(CRHDSTR,U,5)
 
'CRHDLEN CRHDLEN=20
 
CRHDTRG="CRHDRTN"
 
@CRHDTRG
 
CRHDGRP=$O(^ORD(100.98,"B","CONSULTS",0))
 
;D AGET^ORWORR(.CRHDY,DFN,"2^0",11,0,0,"")
 
AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
 
CRHDILST=@CRHDY
 
CRHDILST(.1)
 
DETORD("CRHDRTN",.CRHDLST,.CRHDILST,"",CRHDLEN)
 
Q
IMAGING(CRHDRTN,CRHDSTR) ;Radiology orders - call from cprs
 ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
 
CRHDY,CRHDILST,ORYD,CRHDLST,X,CRHDLEN
 
D1,CRHDATE,DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDTRG,CRHDGRP
 
DFN=+CRHDSTR
 
CRHDSTS=$P(CRHDSTR,U,2)
 
CRHDNUM=$P(CRHDSTR,U,3)
 
CRHDHDR=$P(CRHDSTR,U,4)
 
CRHDLEN=$P(CRHDSTR,U,5)
 
'CRHDLEN CRHDLEN=20
 
CRHDTRG="CRHDRTN"
 
@CRHDTRG
 
CRHDGRP=$O(^ORD(100.98,"B","IMAGING",0))
 
;D AGET^ORWORR(.CRHDY,DFN,"2^0",34,0,0,"")
 
AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
 
CRHDILST=@CRHDY
 
CRHDILST(.1)
 
DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
 
Q
LABS(CRHDRTN,CRHDSTR) ;LABS orders - call from cprs
 ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
 
CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE
 
DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDLEN,CRHDTRG
 
DFN=+CRHDSTR
 
CRHDSTS=$P(CRHDSTR,U,2)
 
CRHDNUM=$P(CRHDSTR,U,3)
 
CRHDHDR=$P(CRHDSTR,U,4)
 
CRHDLEN=$P(CRHDSTR,U,5)
 
'CRHDLEN CRHDLEN=20
 
CRHDTRG="CRHDRTN"
 
@CRHDTRG
 
CRHDGRP=$O(^ORD(100.98,"B","LABORATORY",0))
 
;D AGET^ORWORR(.CRHDY,DFN,"2^0",5,0,0,"")
 
AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
 
CRHDILST=@CRHDY
 
CRHDILST(.1)
 
DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
 
Q
PROC(CRHDRTN,CRHDSTR) ;,DFN,CRHDSTS,CRHDNUM,CRHDHDR) ;Procedures orders - call from cprs
 ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
 
CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE
 
DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDGRP,CRHDLEN,CRHDTRG
 
DFN=+CRHDSTR
 
CRHDSTS=$P(CRHDSTR,U,2)
 
CRHDNUM=$P(CRHDSTR,U,3)
 
CRHDHDR=$P(CRHDSTR,U,4)
 
CRHDLEN=$P(CRHDSTR,U,5)
 
'CRHDLEN CRHDLEN=20
 
CRHDTRG="CRHDRTN"
 
@CRHDTRG
 
CRHDGRP=$O(^ORD(100.98,"B","PROCEDURES",0))
 
;D AGET^ORWORR(.CRHDY,DFN,"2^0",43,0,0,"")
 
AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
 
CRHDILST=@CRHDY
 
CRHDILST(.1)
 
DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
 
Q
DETORD(CRHDTRG,CRHDRLST,CRHDILST,CRHDHEAD,CRHDLEN) ;
 
ORYD,CRHDSTS,CRHDD1,CRHDATE,CRHDX
 
ORYD=""
 
GET4LST^ORWORR(.CRHDRLST,.CRHDILST)
 
S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM,0)=CRHDHEAD_": "
 
CRHDX=""
 
F  S CRHDX=$O(CRHDLST(CRHDX)) Q:'CRHDX  D
 
CRHDD1=$P(CRHDLST(CRHDX),"^",3)
 . 
I $E(CRHDLST(CRHDX),1)="~" D
 
. .CRHDD1=$P(CRHDLST(CRHDX),"^",3)
 . .
CRHDSTS=$P(CRHDLST(CRHDX),"^",10)
 . .
CRHDATE=$$FMTE^XLFDT(CRHDD1,2)
 . .
@CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):16,1:1))_$P(CRHDATE,"@",1)
 . 
I $E(CRHDLST(CRHDX),1)="t" D
 
. .@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)_")"
 
. .@CRHDTRG@(CRHDNUM)=$E(@CRHDTRG@(CRHDNUM),1,CRHDLEN),CRHDNUM=CRHDNUM+1
 
Q
PROB(CRHDRTNA,CRHDSTR) ;DFN,NUM,CRHDHDR) ;
 ;Target array ^TMP("CRHD_PROB_DATA",$J)
 
CRHDRTN,X,DFN,CRHDNUM,CRHDHDR,CRHDTRG
 
DFN=+CRHDSTR
 
CRHDNUM=$P(CRHDSTR,U,2)
 
CRHDHDR=$P(CRHDSTR,U,3)
 
CRHDTRG="^TMP(""CRHD_PROB_DATA"",$J)"
 
@CRHDTRG
 
CRHDNUM=$G(CRHDNUM)+1
 
S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM,0)="Problem List: "
 
LIST^ORQQPL(.CRHDRTN,DFN,"A")
 
CRHDX=0
 
F  S CRHDX=$O(CRHDRTN(CRHDX)) Q:'CRHDX  D
 
@CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):15,1:1))_$P(CRHDRTN(X),"^",2)
 . 
CRHDNUM=CRHDNUM+1
 
;S @CRHDTRG@(CRHDNUM)=""
 
Q
RECNTLAB(CRHDROOT,DFN,CRHDNUM,CRHDHDR) ;
 ;(CRHDY,DFN,CRHDATE1,DIR,FORMAT)
 
INTERIMG^ORWLRR(.CRHDY,DFN,$$DT^XLFDT_".2359",1,"")
 
Q
SPACE(CRHDX1,CRHDX) ;
 
CRHDY,CRHDY1
 
CRHDY1="",CRHDY=CRHDX-$L(CRHDX1)
 
S $P(CRHDY1," ",CRHDY)=""
 
CRHDY1
PARAM(CRHDW,CRHDX) ;
 
Q $$GET^XPAR(CRHDW,CRHDX,1,"I")
 
;
PTSTS(DFN) ;Display current patient status
 
CRHDGPMV,NOW,NOWI,X,Y,%,%H,%I,CRHDA,E,CRHDDGX,VAIP,VAX,VAZ,VAZ2
 
NOW^%DTC (VAX("DAT"),NOW)=%,NOWI=9999999.999999-%
 
LAST^VADPT3
 
CRHDGPMV(1)=$S($D(VAIP("E")):VAIP("E"),1:E;use ifn of last mvt from VADPT cal
 
CRHDDGX=$G(^DGPM(+CRHDGPMV(1),0)),CRHDGPMV(2)=$P(CRHDDGX,"^",2),CRHDGPMV(4)=$P(CRHDDGX,"^",18)
 
CRHDA=$S("^3^5^"[("^"_+CRHDGPMV(2)_"^"):0,1:+CRHDGPMV(2))
 
Q $S('CRHDA:"IN",1:"")_"ACTIVE "_$S("^4^5^"[("^"_+CRHDGPMV(2)_"^"):"LODGER",1:"INPATIENT")
DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
 
CRHDPAR,CRHDSRV,CRHDTEAM
 
CRHDTEAM=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT TEAM",1,"I")
 
CRHDSRV=$$GET1^DIQ(200,DUZ_",",29,"E")
 
CRHDPAR="USR.`"_DUZ
 
GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
 
('CRHDNRTT)&($G(CRHDTEAM)>0) CRHDPAR="OTL.`"_+CRHDTEAM GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
 
('CRHDNRTT)&($G(CRHDSRV)'=""CRHDPAR="SRV."_CRHDSRV GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
 
'+$G(CRHDDIVCRHDDIV=+$$SITE^VASITE
 
'CRHDNRTT CRHDPAR="DIV.`"_+CRHDDIV  GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
 
Q