CRHDPL	; CAIRO/MGH - Find personal lists for changeover list ;04-Mar-2008 16:00;CLC
	;;1.0;CRHD;****;Jan 28, 2008;Build 19
	;=================================================================
DEFPAT(CRHDPATL,DUZ)	;Find the personal list for this person
	N VAIN,CRHDLIST,CRHDCT,CRHDPLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN
	N CRHDDOB,CRHDAGE,CRHDSEX,CRHDDSRC,CRHDJ,CRHDN,CRHDTLST
	S CRHDCT=0
	;get default patient list
	D DEFSRC^ORQPTQ11(.CRHDDSRC)
	D DEFLIST^ORQPTQ11(.CRHDLST)
	I $G(CRHDDSRC)["^Combination" D
	.K CRHDLST
	.I $D(^TMP("OR",$J,"PATIENTS")) D
	..S CRHDN=0
	..F  S CRHDN=$O(^TMP("OR",$J,"PATIENTS",CRHDN)) Q:'CRHDN  S CRHDLST(CRHDN)=^TMP("OR",$J,"PATIENTS",CRHDN,0)
	I $D(CRHDLST) D  Q
	.S CRHDJ=0
	.F  S CRHDJ=$O(CRHDLST(CRHDJ)) Q:'CRHDJ  D
	..S CRHDDFN=+CRHDLST(CRHDJ)
	..Q:'CRHDDFN
	..D PATDATA(CRHDDFN,.CRHDCT)
	.D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
	.I $G(CRHDTLST)="" D DEFSRC^ORQPTQ11(.CRHDTLST)
	Q
PERSLST(CRHDPATL,DUZ)	;
	;If no patient list, get personal list
	D PERSPR^ORQPTQ1(.CRHDLST)
	I $P($G(CRHDLST(1)),U,1) D
	.S CRHDL=0 F  S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL=""  D
	..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
	..D GETPTS
	;If no personal list, look for a default team list
	E  D
	.K CRHDLST
	.D DEFTM^ORQPTQ1(.CRHDLST)
	.I '$P($G(CRHDLST),U,1) S CRHDPATL(1)=CRHDLST Q
	.S CRHDLIST=$P(CRHDLST,U,1)
	.D GETPTS
	Q
GETPTS	;subroutine to return patients on a list
	N J,VADM,VAIP
	S J=0
	F  S J=$O(^OR(100.21,+CRHDLIST,10,J)) Q:J<1  D
	.S CRHDORX=^(J,0),CRHDDFN=$P(CRHDORX,";")
	.D PATDATA(CRHDDFN,.CRHDCT)
	D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
	Q
ALPHA(CRHDPATA,CRHDPATL,CRHDCT)	;
	N TXX
	S TXX=""
	F  S TXX=$O(CRHDPATA(TXX)) Q:TXX=""  S CRHDCT=CRHDCT+1,CRHDPATL(CRHDCT)=CRHDPATA(TXX)
	K CRHDPATA
	Q
PATDATA(CRHDDFN,CRHDCT)	;
	;
	K VAIP,VADM,DFN
	S DFN=CRHDDFN
	D DEM^VADPT,IN5^VADPT
	;Outpatients not valid for changeover list
	;Q:VAIP(1)=""
	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)
	;S CRHDCT=CRHDCT+1
	;S CRHDPATL(CRHDCT)=CRHDDFN_U_CRHDNAME_U_CRHDSSN_U_CRHDDOB_U_CRHDAGE_U_CRHDSEX
	S CRHDPATA(CRHDNAME)=CRHDDFN_U_CRHDNAME_U_CRHDSSN_U_CRHDDOB_U_CRHDAGE_U_CRHDSEX
	Q
SPECPTS(CRHDPATL,SPL)	;
	N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
	S CRHDCT=0
	D SPECPTS^ORQPTQ2(.CRHDLST,.SPL)
	I $P($G(CRHDLST(1)),U,1) D
	.S CRHDL=0 F  S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL=""  D
	..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
	..D PATDATA(CRHDLIST,.CRHDCT)
	.D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
	Q
TEAM(CRHDPATL,TEAM,FLAG)	;
	N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
	S CRHDCT=0
	D TEAMPTS^ORQPTQ1(.CRHDLST,.TEAM,.FLAG)
	I $P($G(CRHDLST(1)),U,1) D
	.S CRHDL=0 F  S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL=""  D
	..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
	..D PATDATA(CRHDLIST,.CRHDCT)
	.D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
	Q
PROV(CRHDPATL,PROV)	;
	N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
	S CRHDCT=0
	D PROVPTS^ORQPTQ2(.CRHDLST,.PROV)
	I $P($G(CRHDLST(1)),U,1) D
	.S CRHDL=0 F  S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL=""  D
	..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
	..D PATDATA(CRHDLIST,.CRHDCT)
	.D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
	Q
WARD(CRHDPATL,WARD)	;
	N VAIN,CRHDLIST,CRHDCT,CRHDLST,CRHDL,CRHDORX,CRHDDFN,CRHDNAME,CRHDSSN,CRHDDOB,CRHDAGE
	S CRHDCT=0
	D BYWARD^ORWPT(.CRHDLST,.WARD)
	I $P($G(CRHDLST(1)),U,1) D
	.S CRHDL=0 F  S CRHDL=$O(CRHDLST(CRHDL)) Q:CRHDL=""  D
	..S CRHDLIST=$P(CRHDLST(CRHDL),U,1)
	..D PATDATA(CRHDLIST,.CRHDCT)
	.D ALPHA(.CRHDPATA,.CRHDPATL,.CRHDCT)
	Q