| [613] | 1 | CRHD3 ; CAIRO/CLC - Modules to support CAIRO Hand-off Tool ;03-Apr-2008 11:22;CLC
|
|---|
| 2 | ;;1.0;CRHD;****;Jan 28, 2008;Build 19
|
|---|
| 3 | ;=================================================================
|
|---|
| 4 | GTEMPTXT(CRHDRTN,CRHDSTR) ;
|
|---|
| 5 | D GETTEXT(.CRHDRTN,.CRHDSTR,1)
|
|---|
| 6 | Q
|
|---|
| 7 | GETTEXT(CRHDRTN,CRHDSTR,DIWF) ;
|
|---|
| 8 | N CRHDFLD,CRHDUSER,CRHDDFN,CRHDVALS,CRHDTEAM,X,CRHDX1
|
|---|
| 9 | N CRHDFLDN,CRHDTRG,CRHDTM,CRHDTSP,CRHDPN,CRHDFG,CRHDX
|
|---|
| 10 | N CRHDLEN,CRHDCT,CRHDWLED,CRHDTMP,CRHDATTN,CRHDDIV,CRHDEX,CRHDZ0,DIWL,DIWR
|
|---|
| 11 | N CRHDEXPD,CRHDFG2,CRHDLEDI,CRHDLL,CRHDLSTT,CRHDMN2,CRHDROOT,CRHDNAM
|
|---|
| 12 | K CRHDRTN
|
|---|
| 13 | S CRHDTRG="^CRHD(183.2)"
|
|---|
| 14 | S CRHDFLD=$P(CRHDSTR,"^",1)
|
|---|
| 15 | S:CRHDFLD'="" CRHDFLD=$$UP^XLFSTR(CRHDFLD)
|
|---|
| 16 | S CRHDUSER=$P(CRHDSTR,"^",2)
|
|---|
| 17 | S CRHDDFN=$P(CRHDSTR,"^",3)
|
|---|
| 18 | S CRHDLEN=$P(CRHDSTR,"^",4)
|
|---|
| 19 | I 'CRHDLEN S CRHDLEN=256
|
|---|
| 20 | S CRHDDIV=$P(CRHDSTR,"^",5)
|
|---|
| 21 | S DIWF=$S(+$G(DIWF):"NR",1:"R")
|
|---|
| 22 | I CRHDDIV="" S CRHDDIV=+$$SITE^VASITE
|
|---|
| 23 | S CRHDATTN=+$G(^DPT(+CRHDDFN,.1041))
|
|---|
| 24 | Q:CRHDFLD=""
|
|---|
| 25 | Q:'CRHDUSER
|
|---|
| 26 | Q:'CRHDDFN
|
|---|
| 27 | ;get expiration date for temp fields
|
|---|
| 28 | S CRHDEX=$$GET^XPAR("DIV.`"_CRHDDIV,"CRHD TEMP FLD EXPIRE",1,"I")
|
|---|
| 29 | S CRHDFLDN=$O(@CRHDTRG@("B",CRHDFLD,0))
|
|---|
| 30 | Q:'CRHDFLDN
|
|---|
| 31 | S CRHDFG=$O(^CRHD(183.2,"C",+CRHDDFN,CRHDFLDN,0))
|
|---|
| 32 | Q:'CRHDFG
|
|---|
| 33 | ;check expiration date here
|
|---|
| 34 | S CRHDZ0=$G(@CRHDTRG@(CRHDFLDN,1,CRHDFG,0)),CRHDLEDI=$P(CRHDZ0,"^",5),CRHDWLED=$P(CRHDZ0,"^",4)
|
|---|
| 35 | ;S CRHDEX=7
|
|---|
| 36 | I 'CRHDEX S CRHDEX=7 ;if parameter not set default to 7 days
|
|---|
| 37 | I CRHDEX&(CRHDLEDI) S CRHDEXPD=$$FMADD^XLFDT(CRHDLEDI,CRHDEX)
|
|---|
| 38 | I $G(CRHDEXPD) I $G(CRHDEXPD)<DT D DELTMPTX^CRHD7(CRHDFLDN,CRHDFG) Q
|
|---|
| 39 | ;
|
|---|
| 40 | S CRHDROOT="^CRHD(183.2,"_CRHDFLDN_",1,"_CRHDFG_")"
|
|---|
| 41 | S DIWL=1,DIWR=CRHDLEN K ^UTILITY($J,"W"),CRHDTMP
|
|---|
| 42 | I DIWF="R" S CRHDCT=1 D B2
|
|---|
| 43 | I DIWF="NR" D
|
|---|
| 44 | .M CRHDTMP(CRHDFLDN)=@CRHDROOT@("TEXT")
|
|---|
| 45 | S CRHDCT=2,CRHDX=0
|
|---|
| 46 | 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)
|
|---|
| 47 | S CRHDCT=99999,CRHDCT=$O(CRHDRTN(CRHDCT),-1)
|
|---|
| 48 | S CRHDNAM=$$GET1^DIQ(200,+CRHDWLED,.01,"E")
|
|---|
| 49 | S CRHDWLED=$$TITLE^XLFSTR($P(CRHDNAM,",",1))_","_$E($P(CRHDNAM,",",2),1)
|
|---|
| 50 | S CRHDRTN(1)=CRHDCT_"^"_$$FMTE^XLFDT(CRHDLEDI,2)_"^"_CRHDWLED
|
|---|
| 51 | Q
|
|---|
| 52 | I DIWF="R" D
|
|---|
| 53 | .S CRHDMN=0
|
|---|
| 54 | .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")
|
|---|
| 55 | .M CRHDTMP=^UTILITY($J,"W") D ^DIWW K ^UTILITY($J,"W")
|
|---|
| 56 | Q
|
|---|
| 57 | B2 ;
|
|---|
| 58 | S CRHDMN=0
|
|---|
| 59 | F S CRHDMN=$O(@CRHDROOT@("TEXT",CRHDMN)) Q:'CRHDMN S CRHDX=@CRHDROOT@("TEXT",CRHDMN,0) D
|
|---|
| 60 | .S CRHDFG2=0
|
|---|
| 61 | .S CRHDMN2=CRHDMN F S CRHDMN2=$O(@CRHDROOT@("TEXT",CRHDMN2)) Q:'CRHDMN2!(CRHDFG2) D
|
|---|
| 62 | ..S CRHDX1=@CRHDROOT@("TEXT",CRHDMN2,0)
|
|---|
| 63 | ..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
|
|---|
| 64 | ..E D
|
|---|
| 65 | ...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
|
|---|
| 66 | ...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=""
|
|---|
| 67 | Q
|
|---|
| 68 | DIWP(CRHDRN,CRHDSTR,CRHDL,CRHDN) ;
|
|---|
| 69 | N CRHDX,CRHDFG
|
|---|
| 70 | ;CRHDRN : Array to return data
|
|---|
| 71 | ;CRHDSTR: String to manipulate
|
|---|
| 72 | ;CRHDL : Length to return
|
|---|
| 73 | ;CRHDN : Next number to use in array
|
|---|
| 74 | I $L(CRHDSTR)<CRHDL S CRHDRN(1,CRHDN,0)=CRHDSTR,CRHDN=CRHDN+1 Q
|
|---|
| 75 | F Q:'$L(CRHDSTR) D
|
|---|
| 76 | .S CRHDFG=0
|
|---|
| 77 | .S CRHDX=$E(CRHDSTR,1,CRHDL)
|
|---|
| 78 | .I $L(CRHDX)<CRHDL S CRHDRN(1,CRHDN,0)=CRHDX,CRHDSTR="",CRHDN=CRHDN+1 Q
|
|---|
| 79 | .F Q:CRHDFG S:$E(CRHDX,$L(CRHDX))=" "!($E(CRHDSTR,$L(CRHDX)+1)=" ") CRHDFG=1 S:'CRHDFG CRHDX=$E(CRHDX,1,$L(CRHDX)-1)
|
|---|
| 80 | .S CRHDRN(1,CRHDN,0)=CRHDX,CRHDSTR=$E(CRHDSTR,$L(CRHDX)+1,$L(CRHDSTR)),CRHDN=CRHDN+1
|
|---|
| 81 | Q
|
|---|
| 82 | 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
|
|---|
| 83 | N CRHDPRIV
|
|---|
| 84 | S CRHDPRIV=0
|
|---|
| 85 | I CRHDUSR'=$P($G(@CRHDTRG@(CRHDFN,1,CRHDMN,0)),"^",2) D
|
|---|
| 86 | . I +$P(@CRHDTRG@(CRHDFN,1,CRHDMN,0),"^",6) S CRHDPRIV=1
|
|---|
| 87 | Q CRHDPRIV
|
|---|
| 88 | GETPTLST(CRHDPATL,CRHDTML) ;
|
|---|
| 89 | N CRHDSTG
|
|---|
| 90 | S CRHDSTG="DFN^NAME^SSN^DOB^AGE^SEX"
|
|---|
| 91 | I $G(CRHDTML)'="" D
|
|---|
| 92 | .S CRHDLSTT=$$UP^XLFSTR($P(CRHDTML,"^",3))
|
|---|
| 93 | .I CRHDLSTT="P"!(CRHDTML["^TEAM") D TEAM(+CRHDTML)
|
|---|
| 94 | .I CRHDLSTT="TEAM" D TEAM(+CRHDTML)
|
|---|
| 95 | .I CRHDLSTT="SPECIALTY" D SPECPTS(+CRHDTML)
|
|---|
| 96 | .I CRHDLSTT="PATLIST"!(CRHDTML["PATLIST") D DEFPATL()
|
|---|
| 97 | .I CRHDLSTT="WARD" D WARD(+CRHDTML)
|
|---|
| 98 | .I CRHDLSTT="PROVIDER"!(CRHDTML["PROVIDER") D PROV(+CRHDTML)
|
|---|
| 99 | I $G(CRHDTML)="" D DEFPATL()
|
|---|
| 100 | Q
|
|---|
| 101 | LISTINPT(Y,CRHDFRM,CRHDDIR) ; Return a bolus of patient names. From is either Name or IEN^Name.
|
|---|
| 102 | N CRHDI2,CRHDIEN,CRHDCNT,CRHDFROM,CRHDORID,CRHDPM
|
|---|
| 103 | S CRHDCNT=44,CRHDI2=0,CRHDFROM=0
|
|---|
| 104 | S CRHDPM=0
|
|---|
| 105 | 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)=""
|
|---|
| 106 | I $D(^TMP("CRHDACA",$J)) D
|
|---|
| 107 | . I $P(CRHDFRM,U,2)'="" S CRHDFROM=$P(CRHDFRM,U,1),CRHDFRM=$O(^TMP("CRHDACA",$J,$P(CRHDFRM,U,2)),-CRHDDIR)
|
|---|
| 108 | . F S CRHDFRM=$O(^TMP("CRHDACA",$J,CRHDFRM),CRHDDIR) Q:CRHDFRM="" D Q:CRHDI2=CRHDCNT
|
|---|
| 109 | . . S CRHDIEN=CRHDFROM,CRHDFROM=0 F S CRHDIEN=$O(^TMP("CRHDACA",$J,CRHDFRM,CRHDIEN)) Q:'CRHDIEN D Q:CRHDI2=CRHDCNT
|
|---|
| 110 | . . . S CRHDORID=""
|
|---|
| 111 | . . . S CRHDORID=$G(^DPT(CRHDIEN,0)) ; Get zero node name.
|
|---|
| 112 | . . . ; S CRHDX1=$G(^DPT(CRHDIEN,.1))_" "_$G(^DPT(CRHDIEN,.101))
|
|---|
| 113 | . . . S CRHDI2=CRHDI2+1 S Y(CRHDI2)=CRHDIEN_U_CRHDFRM_U_U_U_U_$P(CRHDORID,U) ;_"^"_CRHDX ; _"^"_CRHDX1 ;" ("_X_")"
|
|---|
| 114 | Q
|
|---|
| 115 | ISINPT(CRHDDFN) ;is patient an inpatient
|
|---|
| 116 | Q:'CRHDDFN ""
|
|---|
| 117 | Q +$G(^DPT(+CRHDDFN,.105))
|
|---|
| 118 | ;
|
|---|
| 119 | PERLIST(DUZ) ;
|
|---|
| 120 | K CRHDPATL
|
|---|
| 121 | D PERSLST^CRHDPL(.CRHDPATL,DUZ) ;get personal lists
|
|---|
| 122 | Q
|
|---|
| 123 | DEFPATL() ;
|
|---|
| 124 | K CRHDPATL
|
|---|
| 125 | D DEFPAT^CRHDPL(.CRHDPATL,DUZ) ;get default patient list
|
|---|
| 126 | Q
|
|---|
| 127 | TEAM(CRHDTM) ;
|
|---|
| 128 | K CRHDPATL
|
|---|
| 129 | D TEAM^CRHDPL(.CRHDPATL,.CRHDTM,0) ;get patient list
|
|---|
| 130 | Q
|
|---|
| 131 | SPECPTS(CRHDSPEC) ;
|
|---|
| 132 | K CRHDPATL
|
|---|
| 133 | D SPECPTS^CRHDPL(.CRHDPATL,CRHDSPEC) ;get specialty list
|
|---|
| 134 | Q
|
|---|
| 135 | WARD(CRHDWRD) ;
|
|---|
| 136 | K CRHDPATL
|
|---|
| 137 | D WARD^CRHDPL(.CRHDPATL,.CRHDWRD) ;get ward list
|
|---|
| 138 | Q
|
|---|
| 139 | PROV(CRHDPRV) ;
|
|---|
| 140 | K CRHDPATL
|
|---|
| 141 | D PROV^CRHDPL(.CRHDPATL,.CRHDPRV) ;get provider list
|
|---|
| 142 | Q
|
|---|
