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) ;
 
GETTEXT(.CRHDRTN,.CRHDSTR,1)
 
Q
GETTEXT(CRHDRTN,CRHDSTR,DIWF) ;
 
CRHDFLD,CRHDUSER,CRHDDFN,CRHDVALS,CRHDTEAM,X,CRHDX1
 
CRHDFLDN,CRHDTRG,CRHDTM,CRHDTSP,CRHDPN,CRHDFG,CRHDX
 
CRHDLEN,CRHDCT,CRHDWLED,CRHDTMP,CRHDATTN,CRHDDIV,CRHDEX,CRHDZ0,DIWL,DIWR
 
CRHDEXPD,CRHDFG2,CRHDLEDI,CRHDLL,CRHDLSTT,CRHDMN2,CRHDROOT,CRHDNAM
 
CRHDRTN
 
CRHDTRG="^CRHD(183.2)"
 
CRHDFLD=$P(CRHDSTR,"^",1)
 
S:CRHDFLD'="" CRHDFLD=$$UP^XLFSTR(CRHDFLD)
 
CRHDUSER=$P(CRHDSTR,"^",2)
 
CRHDDFN=$P(CRHDSTR,"^",3)
 
CRHDLEN=$P(CRHDSTR,"^",4)
 
'CRHDLEN CRHDLEN=256
 
CRHDDIV=$P(CRHDSTR,"^",5)
 
DIWF=$S(+$G(DIWF):"NR",1:"R")
 
CRHDDIV="" CRHDDIV=+$$SITE^VASITE
 
CRHDATTN=+$G(^DPT(+CRHDDFN,.1041))
 
Q:CRHDFLD=""
 
Q:'CRHDUSER
 
Q:'CRHDDFN
 
;get expiration date for temp fields
 
CRHDEX=$$GET^XPAR("DIV.`"_CRHDDIV,"CRHD TEMP FLD EXPIRE",1,"I")
 
CRHDFLDN=$O(@CRHDTRG@("B",CRHDFLD,0))
 
Q:'CRHDFLDN
 
CRHDFG=$O(^CRHD(183.2,"C",+CRHDDFN,CRHDFLDN,0))
 
Q:'CRHDFG
 
;check expiration date here
 
CRHDZ0=$G(@CRHDTRG@(CRHDFLDN,1,CRHDFG,0)),CRHDLEDI=$P(CRHDZ0,"^",5),CRHDWLED=$P(CRHDZ0,"^",4)
 
;S CRHDEX=7
 
'CRHDEX CRHDEX=7  ;if parameter not set default to 7 days
 
CRHDEX&(CRHDLEDICRHDEXPD=$$FMADD^XLFDT(CRHDLEDI,CRHDEX)
 
I $G(CRHDEXPDI $G(CRHDEXPD)<DT DELTMPTX^CRHD7(CRHDFLDN,CRHDFGQ
 
;
 
CRHDROOT="^CRHD(183.2,"_CRHDFLDN_",1,"_CRHDFG_")"
 
DIWL=1,DIWR=CRHDLEN ^UTILITY($J,"W"),CRHDTMP
 
DIWF="R" CRHDCT=1 B2
 
DIWF="NR" D
 
.CRHDTMP(CRHDFLDN)=@CRHDROOT@("TEXT")
 
CRHDCT=2,CRHDX=0
 
CRHDX=$O(CRHDTMP(CRHDX)) Q:'CRHDX  CRHDX1=0 F  S CRHDX1=$O(CRHDTMP(CRHDX,CRHDX1)) Q:'CRHDX1  CRHDRTN(CRHDX1+1)=CRHDTMP(CRHDX,CRHDX1,0)
 
CRHDCT=99999,CRHDCT=$O(CRHDRTN(CRHDCT),-1)
 
CRHDNAM=$$GET1^DIQ(200,+CRHDWLED,.01,"E")
 
CRHDWLED=$$TITLE^XLFSTR($P(CRHDNAM,",",1))_","_$E($P(CRHDNAM,",",2),1)
 
CRHDRTN(1)=CRHDCT_"^"_$$FMTE^XLFDT(CRHDLEDI,2)_"^"_CRHDWLED
 
Q
 I 
DIWF="R" D
 
.CRHDMN=0
 .
F  S CRHDMN=$O(@CRHDROOT@("TEXT",CRHDMN)) Q:'CRHDMN  CRHDX=@CRHDROOT@("TEXT",CRHDMN,0) S:CRHDX="" CRHDX=" " ^DIWP  ;M TMP=^UTILITY($J,"W")
 
.CRHDTMP=^UTILITY($J,"W"^DIWW ^UTILITY($J,"W")
 
Q
B2 ;
 
CRHDMN=0
 
F  S CRHDMN=$O(@CRHDROOT@("TEXT",CRHDMN)) Q:'CRHDMN  CRHDX=@CRHDROOT@("TEXT",CRHDMN,0) D
 
.CRHDFG2=0
 .
CRHDMN2=CRHDMN F  S CRHDMN2=$O(@CRHDROOT@("TEXT",CRHDMN2)) Q:'CRHDMN2!(CRHDFG2)  D
 
..CRHDX1=@CRHDROOT@("TEXT",CRHDMN2,0)
 ..
($E(CRHDX1,1,3)?1N1". ")!($E(CRHDX1,1,3)?1N1") ")!($E(CRHDX1,1,4)?2N1". ")!($E(CRHDX1,1,4)?2N1") "CRHDX'="" DIWP(.CRHDTMP,CRHDX,CRHDLEN,.CRHDCTCRHDFG2=1,CRHDMN=CRHDMN2-1,CRHDX1="" Q
 
..E  D
 
...($L(CRHDX)+$L(CRHDX1))>256 DIWP(.CRHDTMP,CRHDX,CRHDLEN,.CRHDCTCRHDLL=999,CRHDLL=$O(CRHDTMP(1,CRHDLL),-1) I $L(CRHDTMP(1,CRHDLL,0))<CRHDLEN CRHDX=CRHDTMP(1,CRHDLL,0) CRHDTMP(1,CRHDLL,0) CRHDCT=CRHDCT-1
 ...
S:CRHDX="" CRHDX=" " CRHDX=CRHDX_CRHDX1 ($E(CRHDX,$L(CRHDX)-2,$L(CRHDX))[".")!($E(CRHDX,$L(CRHDX)-2,$L(CRHDX))["?"DIWP(.CRHDTMP,CRHDX,CRHDLEN,.CRHDCTCRHDMN=CRHDMN2,CRHDFG2=1 CRHDX=""
 
Q
DIWP(CRHDRN,CRHDSTR,CRHDL,CRHDN) ;
 
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 CRHDRN(1,CRHDN,0)=CRHDSTR,CRHDN=CRHDN+1 Q
 F  Q
:'$L(CRHDSTR)  D
 
.CRHDFG=0
 .
CRHDX=$E(CRHDSTR,1,CRHDL)
 .
I $L(CRHDX)<CRHDL 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)
 .
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
 
CRHDPRIV
 
CRHDPRIV=0
 
CRHDUSR'=$P($G(@CRHDTRG@(CRHDFN,1,CRHDMN,0)),"^",2) D
 
+$P(@CRHDTRG@(CRHDFN,1,CRHDMN,0),"^",6) CRHDPRIV=1
 
CRHDPRIV
GETPTLST(CRHDPATL,CRHDTML) ;
 
CRHDSTG
 
CRHDSTG="DFN^NAME^SSN^DOB^AGE^SEX"
 
I $G(CRHDTML)'="" D
 
.CRHDLSTT=$$UP^XLFSTR($P(CRHDTML,"^",3))
 .
CRHDLSTT="P"!(CRHDTML["^TEAM"TEAM(+CRHDTML)
 .
CRHDLSTT="TEAM" TEAM(+CRHDTML)
 .
CRHDLSTT="SPECIALTY" SPECPTS(+CRHDTML)
 .
CRHDLSTT="PATLIST"!(CRHDTML["PATLIST"DEFPATL()
 .
CRHDLSTT="WARD" WARD(+CRHDTML)
 .
CRHDLSTT="PROVIDER"!(CRHDTML["PROVIDER"PROV(+CRHDTML)
 
I $G(CRHDTML)="" DEFPATL()
 
Q
LISTINPT(Y,CRHDFRM,CRHDDIR) ; Return a bolus of patient names.  From is either Name or IEN^Name.
 
CRHDI2,CRHDIEN,CRHDCNT,CRHDFROM,CRHDORID,CRHDPM
 
CRHDCNT=44,CRHDI2=0,CRHDFROM=0
 
CRHDPM=0
 
F  S CRHDPM=$O(^DPT("ACA",CRHDPM)) Q:'CRHDPM  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)'="" CRHDFROM=$P(CRHDFRM,U,1),CRHDFRM=$O(^TMP("CRHDACA",$J,$P(CRHDFRM,U,2)),-CRHDDIR)
 . 
F  S CRHDFRM=$O(^TMP("CRHDACA",$J,CRHDFRM),CRHDDIRQ:CRHDFRM=""  D  Q:CRHDI2=CRHDCNT
 
. . CRHDIEN=CRHDFROM,CRHDFROM=0 F  S CRHDIEN=$O(^TMP("CRHDACA",$J,CRHDFRM,CRHDIEN)) Q:'CRHDIEN  D  Q:CRHDI2=CRHDCNT
 
. . . CRHDORID=""
 
. . . CRHDORID=$G(^DPT(CRHDIEN,0)) ; Get zero node name.
 
. . . ; S CRHDX1=$G(^DPT(CRHDIEN,.1))_" "_$G(^DPT(CRHDIEN,.101))
 
. . . CRHDI2=CRHDI2+1 Y(CRHDI2)=CRHDIEN_U_CRHDFRM_U_U_U_U_$P(CRHDORID,U;_"^"_CRHDX ; _"^"_CRHDX1  ;"   ("_X_")"
 
Q
ISINPT(CRHDDFN) ;is patient an inpatient
 
Q:'CRHDDFN ""
 
+$G(^DPT(+CRHDDFN,.105))
 
;
PERLIST(DUZ) ;
 
CRHDPATL
 
PERSLST^CRHDPL(.CRHDPATL,DUZ)  ;get personal lists
 
Q
DEFPATL() ;
 
CRHDPATL
 
DEFPAT^CRHDPL(.CRHDPATL,DUZ)   ;get default patient list
 
Q
TEAM(CRHDTM) ;
 
CRHDPATL
 
TEAM^CRHDPL(.CRHDPATL,.CRHDTM,0)   ;get patient list
 
Q
SPECPTS(CRHDSPEC) ;
 
CRHDPATL
 
SPECPTS^CRHDPL(.CRHDPATL,CRHDSPEC)  ;get specialty list
 
Q
WARD(CRHDWRD) ;
 
CRHDPATL
 
WARD^CRHDPL(.CRHDPATL,.CRHDWRD)  ;get ward list
 
Q
PROV(CRHDPRV) ;
 
CRHDPATL
 
PROV^CRHDPL(.CRHDPATL,.CRHDPRV)  ;get provider list
 
Q