CRHD3	; CAIRO/CLC - Modules to support CAIRO Hand-off Tool ;03-Apr-2008 11:22;CLC
	;;1.0;CRHD;****;Jan 28, 2008;Build 19
	;=================================================================
GTEMPTXT(CRHDRTN,CRHDSTR)	;
	D GETTEXT(.CRHDRTN,.CRHDSTR,1)
	Q
GETTEXT(CRHDRTN,CRHDSTR,DIWF)	;
	N CRHDFLD,CRHDUSER,CRHDDFN,CRHDVALS,CRHDTEAM,X,CRHDX1
	N CRHDFLDN,CRHDTRG,CRHDTM,CRHDTSP,CRHDPN,CRHDFG,CRHDX
	N CRHDLEN,CRHDCT,CRHDWLED,CRHDTMP,CRHDATTN,CRHDDIV,CRHDEX,CRHDZ0,DIWL,DIWR
	N CRHDEXPD,CRHDFG2,CRHDLEDI,CRHDLL,CRHDLSTT,CRHDMN2,CRHDROOT,CRHDNAM
	K CRHDRTN
	S CRHDTRG="^CRHD(183.2)"
	S CRHDFLD=$P(CRHDSTR,"^",1)
	S:CRHDFLD'="" CRHDFLD=$$UP^XLFSTR(CRHDFLD)
	S CRHDUSER=$P(CRHDSTR,"^",2)
	S CRHDDFN=$P(CRHDSTR,"^",3)
	S CRHDLEN=$P(CRHDSTR,"^",4)
	I 'CRHDLEN S CRHDLEN=256
	S CRHDDIV=$P(CRHDSTR,"^",5)
	S DIWF=$S(+$G(DIWF):"NR",1:"R")
	I CRHDDIV="" S CRHDDIV=+$$SITE^VASITE
	S CRHDATTN=+$G(^DPT(+CRHDDFN,.1041))
	Q:CRHDFLD=""
	Q:'CRHDUSER
	Q:'CRHDDFN
	;get expiration date for temp fields
	S CRHDEX=$$GET^XPAR("DIV.`"_CRHDDIV,"CRHD TEMP FLD EXPIRE",1,"I")
	S CRHDFLDN=$O(@CRHDTRG@("B",CRHDFLD,0))
	Q:'CRHDFLDN
	S CRHDFG=$O(^CRHD(183.2,"C",+CRHDDFN,CRHDFLDN,0))
	Q:'CRHDFG
	;check expiration date here
	S CRHDZ0=$G(@CRHDTRG@(CRHDFLDN,1,CRHDFG,0)),CRHDLEDI=$P(CRHDZ0,"^",5),CRHDWLED=$P(CRHDZ0,"^",4)
	;S CRHDEX=7
	I 'CRHDEX S CRHDEX=7  ;if parameter not set default to 7 days
	I CRHDEX&(CRHDLEDI) S CRHDEXPD=$$FMADD^XLFDT(CRHDLEDI,CRHDEX)
	I $G(CRHDEXPD) I $G(CRHDEXPD)<DT D DELTMPTX^CRHD7(CRHDFLDN,CRHDFG) Q
	;
	S CRHDROOT="^CRHD(183.2,"_CRHDFLDN_",1,"_CRHDFG_")"
	S DIWL=1,DIWR=CRHDLEN K ^UTILITY($J,"W"),CRHDTMP
	I DIWF="R" S CRHDCT=1 D B2
	I DIWF="NR" D
	.M CRHDTMP(CRHDFLDN)=@CRHDROOT@("TEXT")
	S CRHDCT=2,CRHDX=0
	S CRHDX=$O(CRHDTMP(CRHDX)) Q:'CRHDX  S CRHDX1=0 F  S CRHDX1=$O(CRHDTMP(CRHDX,CRHDX1)) Q:'CRHDX1  S CRHDRTN(CRHDX1+1)=CRHDTMP(CRHDX,CRHDX1,0)
	S CRHDCT=99999,CRHDCT=$O(CRHDRTN(CRHDCT),-1)
	S CRHDNAM=$$GET1^DIQ(200,+CRHDWLED,.01,"E")
	S CRHDWLED=$$TITLE^XLFSTR($P(CRHDNAM,",",1))_","_$E($P(CRHDNAM,",",2),1)
	S CRHDRTN(1)=CRHDCT_"^"_$$FMTE^XLFDT(CRHDLEDI,2)_"^"_CRHDWLED
	Q
	I DIWF="R" D
	.S CRHDMN=0
	.F  S CRHDMN=$O(@CRHDROOT@("TEXT",CRHDMN)) Q:'CRHDMN  S CRHDX=@CRHDROOT@("TEXT",CRHDMN,0) S:CRHDX="" CRHDX=" " D ^DIWP  ;M TMP=^UTILITY($J,"W")
	.M CRHDTMP=^UTILITY($J,"W") D ^DIWW K ^UTILITY($J,"W")
	Q
B2	;
	S CRHDMN=0
	F  S CRHDMN=$O(@CRHDROOT@("TEXT",CRHDMN)) Q:'CRHDMN  S CRHDX=@CRHDROOT@("TEXT",CRHDMN,0) D
	.S CRHDFG2=0
	.S CRHDMN2=CRHDMN F  S CRHDMN2=$O(@CRHDROOT@("TEXT",CRHDMN2)) Q:'CRHDMN2!(CRHDFG2)  D
	..S CRHDX1=@CRHDROOT@("TEXT",CRHDMN2,0)
	..I ($E(CRHDX1,1,3)?1N1". ")!($E(CRHDX1,1,3)?1N1") ")!($E(CRHDX1,1,4)?2N1". ")!($E(CRHDX1,1,4)?2N1") ") I CRHDX'="" D DIWP(.CRHDTMP,CRHDX,CRHDLEN,.CRHDCT) S CRHDFG2=1,CRHDMN=CRHDMN2-1,CRHDX1="" Q
	..E  D
	...I ($L(CRHDX)+$L(CRHDX1))>256 D DIWP(.CRHDTMP,CRHDX,CRHDLEN,.CRHDCT) S CRHDLL=999,CRHDLL=$O(CRHDTMP(1,CRHDLL),-1) I $L(CRHDTMP(1,CRHDLL,0))<CRHDLEN S CRHDX=CRHDTMP(1,CRHDLL,0) K CRHDTMP(1,CRHDLL,0) S CRHDCT=CRHDCT-1
	...S:CRHDX="" CRHDX=" " S CRHDX=CRHDX_CRHDX1 I ($E(CRHDX,$L(CRHDX)-2,$L(CRHDX))[".")!($E(CRHDX,$L(CRHDX)-2,$L(CRHDX))["?") D DIWP(.CRHDTMP,CRHDX,CRHDLEN,.CRHDCT) S CRHDMN=CRHDMN2,CRHDFG2=1 S CRHDX=""
	Q
DIWP(CRHDRN,CRHDSTR,CRHDL,CRHDN)	;
	N CRHDX,CRHDFG
	;CRHDRN : Array to return data
	;CRHDSTR: String to manipulate
	;CRHDL  : Length to return
	;CRHDN  : Next number to use in array
	I $L(CRHDSTR)<CRHDL S CRHDRN(1,CRHDN,0)=CRHDSTR,CRHDN=CRHDN+1 Q
	F  Q:'$L(CRHDSTR)  D
	.S CRHDFG=0
	.S CRHDX=$E(CRHDSTR,1,CRHDL)
	.I $L(CRHDX)<CRHDL S CRHDRN(1,CRHDN,0)=CRHDX,CRHDSTR="",CRHDN=CRHDN+1 Q
	.F  Q:CRHDFG  S:$E(CRHDX,$L(CRHDX))=" "!($E(CRHDSTR,$L(CRHDX)+1)=" ") CRHDFG=1 S:'CRHDFG CRHDX=$E(CRHDX,1,$L(CRHDX)-1)
	.S CRHDRN(1,CRHDN,0)=CRHDX,CRHDSTR=$E(CRHDSTR,$L(CRHDX)+1,$L(CRHDSTR)),CRHDN=CRHDN+1
	Q
PRIV(CRHDUSR,CRHDFN,CRHDMN)	;returns 1 if note is private, viewable only to the author; 0 anyone on the authors team or treating specialty or attending can view
	N CRHDPRIV
	S CRHDPRIV=0
	I CRHDUSR'=$P($G(@CRHDTRG@(CRHDFN,1,CRHDMN,0)),"^",2) D
	. I +$P(@CRHDTRG@(CRHDFN,1,CRHDMN,0),"^",6) S CRHDPRIV=1
	Q CRHDPRIV
GETPTLST(CRHDPATL,CRHDTML)	;
	N CRHDSTG
	S CRHDSTG="DFN^NAME^SSN^DOB^AGE^SEX"
	I $G(CRHDTML)'="" D
	.S CRHDLSTT=$$UP^XLFSTR($P(CRHDTML,"^",3))
	.I CRHDLSTT="P"!(CRHDTML["^TEAM") D TEAM(+CRHDTML)
	.I CRHDLSTT="TEAM" D TEAM(+CRHDTML)
	.I CRHDLSTT="SPECIALTY" D SPECPTS(+CRHDTML)
	.I CRHDLSTT="PATLIST"!(CRHDTML["PATLIST") D DEFPATL()
	.I CRHDLSTT="WARD" D WARD(+CRHDTML)
	.I CRHDLSTT="PROVIDER"!(CRHDTML["PROVIDER") D PROV(+CRHDTML)
	I $G(CRHDTML)="" D DEFPATL()
	Q
LISTINPT(Y,CRHDFRM,CRHDDIR)	; Return a bolus of patient names.  From is either Name or IEN^Name.
	N CRHDI2,CRHDIEN,CRHDCNT,CRHDFROM,CRHDORID,CRHDPM
	S CRHDCNT=44,CRHDI2=0,CRHDFROM=0
	S CRHDPM=0
	F  S CRHDPM=$O(^DPT("ACA",CRHDPM)) Q:'CRHDPM  S CRHDIEN=0 F  S CRHDIEN=$O(^DPT("ACA",CRHDPM,CRHDIEN)) Q:'CRHDIEN  S:$P($G(^DPT(+CRHDIEN,0)),"^",1)'="" ^TMP("CRHDACA",$J,$P(^DPT(+CRHDIEN,0),"^",1),CRHDIEN)=""
	I $D(^TMP("CRHDACA",$J)) D
	. I $P(CRHDFRM,U,2)'="" S CRHDFROM=$P(CRHDFRM,U,1),CRHDFRM=$O(^TMP("CRHDACA",$J,$P(CRHDFRM,U,2)),-CRHDDIR)
	. F  S CRHDFRM=$O(^TMP("CRHDACA",$J,CRHDFRM),CRHDDIR) Q:CRHDFRM=""  D  Q:CRHDI2=CRHDCNT
	. . S CRHDIEN=CRHDFROM,CRHDFROM=0 F  S CRHDIEN=$O(^TMP("CRHDACA",$J,CRHDFRM,CRHDIEN)) Q:'CRHDIEN  D  Q:CRHDI2=CRHDCNT
	. . . S CRHDORID=""
	. . . S CRHDORID=$G(^DPT(CRHDIEN,0)) ; Get zero node name.
	. . . ; S CRHDX1=$G(^DPT(CRHDIEN,.1))_" "_$G(^DPT(CRHDIEN,.101))
	. . . S CRHDI2=CRHDI2+1 S Y(CRHDI2)=CRHDIEN_U_CRHDFRM_U_U_U_U_$P(CRHDORID,U) ;_"^"_CRHDX ; _"^"_CRHDX1  ;"   ("_X_")"
	Q
ISINPT(CRHDDFN)	;is patient an inpatient
	Q:'CRHDDFN ""
	Q +$G(^DPT(+CRHDDFN,.105))
	;
PERLIST(DUZ)	;
	K CRHDPATL
	D PERSLST^CRHDPL(.CRHDPATL,DUZ)  ;get personal lists
	Q
DEFPATL()	;
	K CRHDPATL
	D DEFPAT^CRHDPL(.CRHDPATL,DUZ)   ;get default patient list
	Q
TEAM(CRHDTM)	;
	K CRHDPATL
	D TEAM^CRHDPL(.CRHDPATL,.CRHDTM,0)   ;get patient list
	Q
SPECPTS(CRHDSPEC)	;
	K CRHDPATL
	D SPECPTS^CRHDPL(.CRHDPATL,CRHDSPEC)  ;get specialty list
	Q
WARD(CRHDWRD)	;
	K CRHDPATL
	D WARD^CRHDPL(.CRHDPATL,.CRHDWRD)  ;get ward list
	Q
PROV(CRHDPRV)	;
	K CRHDPATL
	D PROV^CRHDPL(.CRHDPATL,.CRHDPRV)  ;get provider list
	Q