CRHD9	; CAIRO/CLC - HANDOFF TEAM LIST ;4/24/08  12:49
	;;1.0;CRHD;****;Jan 28, 2008;Build 19
	;=================================================================
HOTMSAVE(CRHDRTN,CRHDTM)	;
	;create a team name
	N CRHDFDA,CRHDOUT,CRHDERR
	K CRHDRTN
	S CRHDRTN=0
	I (CRHDTM'?1A.E)&(CRHDTM'?1N.E) Q
	S CRHDFDA(183.3,"?+1,",.01)=CRHDTM
	D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
	I '$D(CRHDERR) S CRHDRTN=CRHDOUT(1)
	Q
HOTMDEL(CRHDRTN,CRHDTM)	;
	;delete a Hand off team
	N DIK,DA
	K CRHDRTN
	S CRHDRTN=0
	I +CRHDTM S DIK="^CRHD(183.3,",DA=+CRHDTM D ^DIK S CRHDRTN=1
	Q
HOLIST(CRHDRTN)	;
	;return a list of teams
	N CRHDX,CRHDX1,CRHDTDT,CRHDCT
	K CRHDRTN
	S CRHDX=""
	S CRHDCT=0
	S CRHDRTN(0)="0^No List Found"
	F  S CRHDX=$O(^CRHD(183.3,"B",CRHDX)) Q:CRHDX=""  D
	.S CRHDX1=0
	.F  S CRHDX1=$O(^CRHD(183.3,"B",CRHDX,CRHDX1)) Q:'CRHDX1  D
	..;check to see if team list is active, if date is less then today then inactive
	..S CRHDTDT=$P($G(^CRHD(183.3,CRHDX1,0)),"^",2)
	..I CRHDTDT&(CRHDTDT<$$DT^XLFDT) Q
	..S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDX1_"^"_CRHDX_"^"_"HOTEAM"
	I CRHDCT>0 K CRHDRTN(0)
	Q
HOPLIST(CRHDRTN,CRHDTM)	;
	;Get list of Patients for a HO team
	N CRHDX,CRHDPT,CRHDPD,CRHDTLST,CRHDCT,CRHDPD2,VAIP,DFN,DIE,DA,DR
	K CRHDRTN
	S CRHDRTN(1)="No Patients Found"
	Q:'CRHDTM
	I '$D(^CRHD(183.3,"B",$P(CRHDTM,"^",2),+CRHDTM)) Q
	S CRHDX=0
	F  S CRHDX=$O(^CRHD(183.3,+CRHDTM,1,CRHDX)) Q:'CRHDX  D
	.S CRHDPT=+$G(^CRHD(183.3,+CRHDTM,1,CRHDX,0))
	.;check to see if patient has been discharged, if so delete from list
	.S DFN=CRHDPT D IN5^VADPT
	.I VAIP(1)="" D  Q
	..S DA(1)=+CRHDTM,DIE="^CRHD(183.3,"_DA(1)_",1,",DA=CRHDX,DR=".01///@" D ^DIE
	.S CRHDPD=$$PATDATA(CRHDPT)
	.K CRHDPD2
	.D PATPRV(.CRHDPD2,CRHDTM,CRHDPT)
	.I $P(CRHDPD,"^",2)'="" S CRHDTLST($P(CRHDPD,"^",2))=CRHDPD
	.I $G(CRHDPD2)'="" S CRHDTLST($P(CRHDPD,"^",2))=CRHDTLST($P(CRHDPD,"^",2))_"^*"_CRHDPD2
	I $D(CRHDTLST) D
	.S CRHDCT=0
	.S CRHDX=""
	.F  S CRHDX=$O(CRHDTLST(CRHDX)) Q:CRHDX=""  S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTLST(CRHDX)
	Q
PATDATA(DFN)	;
	;
	N CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE,CRHDSEX,VAIP,VADM
	K VAIP,VADM
	D DEM^VADPT,IN5^VADPT
	S CRHDNAME=VADM(1),CRHDSSN=$P(VADM(2),U,1),CRHDDOB=$P(VADM(3),U,1)
	S CRHDAGE=VADM(4),CRHDSEX=$P(VADM(5),U,1)
	K VAIP,VADM
	Q DFN_U_CRHDNAME_U_CRHDSSN_U_CRHDDOB_U_CRHDAGE_U_CRHDSEX
	;
HODLIST(CRHDRTN,CRHDTM)	;Get list of Providers for a HO team
	N CRHDX,CRHDPRV,CRHDTLST,CRHDCT,CRHDZ0,CRHDSORT,CRHDUT
	N CRHDPX,CRHDPX0,CRHDNAM
	K CRHDRTN
	I '$D(^CRHD(183.3,"B",$P(CRHDTM,"^",2),+CRHDTM)) Q
	S CRHDX=0
	F  S CRHDX=$O(^CRHD(183.3,+CRHDTM,2,CRHDX)) Q:'CRHDX  D
	.S CRHDPRV=+$G(^CRHD(183.3,+CRHDTM,2,CRHDX,0))
	.S CRHDNAM=$$GET1^DIQ(200,+CRHDPRV,.01,"E")
	.;Delete Provider if inactive, 1st check to see if assigned to a patient, if so remove
	.I '$$ACTIVE^XUSER(+CRHDPRV) D  Q
	..S CRHDPX=0 F  S CRHDPX=$O(^CRHD(183.3,+CRHDTM,1,CRHDPX)) Q:'CRHDPX  D
	...S CRHDPX0=^CRHD(183.3,+CRHDTM,1,CRHDPX,0)
	...I CRHDPX0[+CRHDPRV F CRHDI=2:1:$L(CRHDPX0,"^") I $P(CRHDPX0,"^",CRHDI)=+CRHDPRV S $P(^CRHD(183.3,+CRHDTM,1,CRHDPX,0),"^",CRHDI)=""
	..S DA(1)=+CRHDTM,DIE="^CRHD(183.3,"_DA(1)_",2,",DA=CRHDX,DR=".01///@" D ^DIE
	.I CRHDNAM'="" D
	..S CRHDZ0=$G(^CRHD(183.3,+CRHDTM,2,+CRHDX,0))
	..S CRHDUT=$P(CRHDZ0,"^",2)
	..I CRHDUT="" S CRHDUT="ZNOTYPE"
	..S CRHDSORT(CRHDUT,CRHDNAM)=CRHDPRV_"^"_CRHDNAM_"^"_$P(CRHDZ0,"^",2)_"^"_+$P(CRHDZ0,"^",3)_"^"_+$P(CRHDZ0,"^",4)_"^"_$P(CRHDZ0,"^",5)_"^"_$P(CRHDZ0,"^",6)
	S CRHDI=""
	F  S CRHDI=$O(CRHDSORT(CRHDI)) Q:CRHDI=""  D
	.S CRHDPRV=""
	.F  S CRHDPRV=$O(CRHDSORT(CRHDI,CRHDPRV)) Q:CRHDPRV=""  D
	..S CRHDTLST(CRHDPRV)=CRHDSORT(CRHDI,CRHDPRV)
	..;S CRHDTLST(CRHDNAM)=CRHDPRV_"^"_CRHDNAM_"^"_$P(CRHDZ0,"^",2)_"^"_+$P(CRHDZ0,"^",3)_"^"_+$P(CRHDZ0,"^",4)_"^"_$P(CRHDZ0,"^",5)_"^"_$P(CRHDZ0,"^",6)
	I $D(CRHDTLST) D
	.S CRHDCT=0
	.S CRHDX=""
	.F  S CRHDX=$O(CRHDTLST(CRHDX)) Q:CRHDX=""  S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTLST(CRHDX)
	Q
CANEDIT(CRHDRTN,CRHDTM,DUZ)	;
	;Can user edit team list
	N CRHDPRV,CRHDMGR,CRHDA
	Q:CRHDTM=""
	;S CRHDRTN="1^1"
	S CRHDA=$$GET1^DIQ(200,+DUZ,3,"I")
	S CRHDRTN="0^0"
	I CRHDA["@" S CRHDRTN="1^1" Q
	D HOTMMGR^CRHD1(.CRHDMGR,DUZ)
	I CRHDMGR S CRHDRTN="1^1" Q
	S CRHDPRV=$O(^CRHD(183.3,+CRHDTM,2,"B",+DUZ,0))
	I 'CRHDPRV Q
	E  S CRHDRTN=+$P($G(^CRHD(183.3,+CRHDTM,2,+CRHDPRV,0)),"^",3)_"^"_+$P($G(^CRHD(183.3,+CRHDTM,2,+CRHDPRV,0)),"^",4)
	Q
PATPRV(CRHDRTN,CRHDTM,CRHDDFN)	;
	;return Providers assigned to patient on list
	N CRHDPAT,CRHDNAM,CRHDZ0,CRHDP,CRHDATTN,CRHDRES,CRHDINT,CRHDFEL,CRHDMST,CRHDNUR,CRHDVP,CRHDI,CRHDI2
	S CRHDVP="^CRHDATTN^CRHDRES^CRHDINT^CRHDFEL^CRHDMST^CRHDNUR"
	S CRHDPAT=$O(^CRHD(183.3,+CRHDTM,1,"B",+CRHDDFN,0))
	I 'CRHDPAT Q
	S CRHDZ0=$G(^CRHD(183.3,+CRHDTM,1,+CRHDPAT,0))
	;I need to add, if the physician is not on team list delete from patient.
	F CRHDI=2:1:7 S CRHDP=$P(CRHDZ0,"^",CRHDI) D
	.I '$D(@$P(CRHDVP,"^",CRHDI)) S @$P(CRHDVP,"^",CRHDI)=""
	.I CRHDP["," D
	..F CRHDI2=1:1:$L(CRHDP,",") D
	...I '$D(^CRHD(183.3,CRHDTM,2,"B",$P(CRHDP,",",CRHDI2))) Q
	...S CRHDNAM=$$GET1^DIQ(200,+$P(CRHDP,",",CRHDI2),.01,"E")
	...S @$P(CRHDVP,"^",CRHDI)=@$P(CRHDVP,"^",CRHDI)_+$P(CRHDP,",",CRHDI2)_"^"_CRHDNAM_"+"
	.;E  S:+CRHDP&($D(^CRHD(183.3,+CRHDTM,2,"B",+CRHDP))) @$P(CRHDVP,"^",CRHDI)=+CRHDP_"^"_$$GET1^DIQ(200,+CRHDP,.01,"E")
	.E  S:+CRHDP @$P(CRHDVP,"^",CRHDI)=+CRHDP_"^"_$$GET1^DIQ(200,+CRHDP,.01,"E")
	F CRHDI=2:1:7 I $E(@$P(CRHDVP,"^",CRHDI),$L(@$P(CRHDVP,"^",CRHDI)))="+" S @$P(CRHDVP,"^",CRHDI)=$E(@$P(CRHDVP,"^",CRHDI),1,$L(@$P(CRHDVP,"^",CRHDI))-1)
	S CRHDRTN=CRHDDFN_";"_$G(CRHDATTN)_";"_$G(CRHDRES)_";"_$G(CRHDINT)_";"_$G(CRHDFEL)_";"_$G(CRHDMST)_";"_$G(CRHDNUR)
	Q
USERPHPG(CRHDRTN,DUZ)	;
	N CRHDOP,CRHDPG
	S CRHDOP=$$GET1^DIQ(200,+DUZ_",",.132,"E")             ;OFFICE PHONE
	S CRHDPG=$$GET1^DIQ(200,+DUZ_",",.138,"E")             ;PAGER
	S CRHDRTN=$S($L(CRHDOP)>2:CRHDOP,1:"")_"^"_$S($L(CRHDPG)>2:CRHDPG,1:"")
	Q
PRVINFO(CRHDRTN,CRHDTM,DUZ)	;
	;return user information
	N CRHDPRV,CRHDZ0,CRHDMGR
	Q:CRHDTM=""
	;S CRHDRTN(1)="0^0"
	S CRHDPRV=$O(^CRHD(183.3,+CRHDTM,2,"B",+DUZ,0))
	I 'CRHDPRV Q
	S CRHDZ0=$G(^CRHD(183.3,+CRHDTM,2,+CRHDPRV,0))
	D MGR^CRHD7(.CRHDMGR,DUZ)
	I ($$GET1^DIQ(200,+DUZ,3,"E")["@")!(+CRHDMGR) S $P(CRHDZ0,"^",3)=1,$P(CRHDZ0,"^",4)=1
	S CRHDRTN=$P(CRHDZ0,"^",1)_"^"_$$GET1^DIQ(200,+CRHDZ0,.01,"E")_"^"_$P(CRHDZ0,"^",2,$L(CRHDZ0,"^"))
	Q
MOD(CRHDRTN,CRHDTM,CRHDLTYP,CRHDTXT,CRHDKFG)	;
	N CRHDX,CRHDFDA,CRHDOUT,CRHDERR
	K CRHDRTN
	S CRHDRTN(0)=0
	I '$D(^CRHD(183.3,"B",$P(CRHDTM,"^",2),+CRHDTM)) Q
	I CRHDLTYP="P" D
	.K:CRHDKFG ^CRHD(183.3,+CRHDTM,1)
	.S CRHDX=0
	.F  S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX  D
	..I CRHDTXT(CRHDX)["~" S CRHDTXT(CRHDX)=$P(CRHDTXT(CRHDX),"~",2)
	..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",.01)=+$P(CRHDTXT(CRHDX),"^",1)
	..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",1)=+$P(CRHDTXT(CRHDX),";",2)
	..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",2)=+$P(CRHDTXT(CRHDX),";",3)
	..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",3)=+$P(CRHDTXT(CRHDX),";",4)
	..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",4)=+$P(CRHDTXT(CRHDX),";",5)
	..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",5)=+$P(CRHDTXT(CRHDX),";",6)
	..S CRHDFDA(183.31,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",6)=+$P(CRHDTXT(CRHDX),";",7)
	.D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
	.I '$D(CRHDERR) S CRHDRTN(0)=1
	.E  S CRHDRTN(1)=1
	I CRHDLTYP="D" D
	.K:CRHDKFG ^CRHD(183.3,+CRHDTM,2)
	.S CRHDX=0
	.F  S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX  D
	..I CRHDTXT(CRHDX)["~" S CRHDTXT(CRHDX)=$P(CRHDTXT(CRHDX),"~",2)
	..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",.01)=$P(CRHDTXT(CRHDX),"^",1)
	..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",1)=$P(CRHDTXT(CRHDX),"^",3)
	..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",2)=$P(CRHDTXT(CRHDX),"^",4)
	..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",3)=$P(CRHDTXT(CRHDX),"^",5)
	..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",4)=$P(CRHDTXT(CRHDX),"^",6)
	..S CRHDFDA(183.32,"?+"_(CRHDX+1)_","_+CRHDTM_","_"",5)=$P(CRHDTXT(CRHDX),"^",7)
	.D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
	.I '$D(CRHDERR) S CRHDRTN(0)=1
	.E  S CRHDRTN(1)=1
	K CRHDFDA,CRHDOUT,CRHDERR
	Q
FILENSAV(CRHDRTN,CRHDTM,CRHDFNM)	;
	;save filename for a team
	N CRHDFDA,CRHDOUT,CRHDERR,CRHDA
	K CRHDRTN
	S CRHDRTN=0
	;I CRHDTM'?1A.E Q
	S CRHDFDA(183.4,"?+1,",.01)=$P(CRHDTM,"^",2)
	D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
	I '$D(CRHDERR) D
	.S CRHDA=CRHDOUT(1)
	.K CRHDFDA,CRHDOUT
	.I CRHDA D
	..S CRHDFDA(183.4,CRHDA_",",2)=CRHDFNM
	..D FILE^DIE("","CRHDFDA")
	..S CRHDRTN=1
	Q
FILENGET(CRHDRTN,CRHDTM)	;
	;get filename for a team
	S CRHDRTN=$$GET1^DIQ(183.4,+$$FIND1^DIC(183.4,"","X",$P(CRHDTM,"^",2),"","","ERR")_",",2,"I")
	Q