CRHD5	; CAIRO/CLC - MISC ROUTINE FOR CAIRO HAND-OFF TOOL ;20-Mar-2008 13:28;CLC
	;;1.0;CRHD;****;Jan 28, 2008;Build 19
	;=================================================================
SRV(CRHDY)	; RETURN LIST OF SERVICES/SECTIONS
	N CRHDI,CRHDIEN,CRHDNAME
	S CRHDI=1,CRHDNAME=""
	F  S CRHDNAME=$O(^DIC(49,"B",CRHDNAME)) Q:CRHDNAME=""  S CRHDIEN=$O(^(CRHDNAME,0)) D
	. S CRHDY(CRHDI)=CRHDIEN_"^"_CRHDNAME,CRHDI=CRHDI+1
	Q
DIV(CRHDY)	; RETURN LIST OF INSTITUTIONS
	N CRHDI,CRHDIEN,CRHDNAME,CRHDIVST,CRHDINA
	S CRHDI=1,CRHDNAME=""
	F  S CRHDNAME=$O(^DIC(4,"B",CRHDNAME)) Q:CRHDNAME=""  S CRHDIEN=$O(^(CRHDNAME,0)) D
	.S CRHDINA=$$GET1^DIQ(4,CRHDIEN_",",101,"I")
	.S CRHDIVST=$$GET1^DIQ(4,CRHDIEN_",",11,"I")
	.I 'CRHDINA S CRHDY(CRHDI)=CRHDIEN_"^"_CRHDNAME,CRHDI=CRHDI+1
	Q
SET(CRHDENT,CRHDP,CRHDS,CRHDVAL)	;Set the parameter
	;D PUT^XPAR("DIV.`583","CRHD DNR ORDER TITLE",2,"Patient DNR Orders")
	;CRHDENT=entity
	;CRHDP=Parameter name
	;CRHDS=Sequence (count)
	;CRHDVAL=parameter value
	N CRHDERR,CRHDFG
	;
	S CRHDFG=1
	D PUT^XPAR(CRHDENT,CRHDP,+CRHDS,CRHDVAL,.CRHDERR)
	I CRHDERR>0 S CRHDFG=0
	Q CRHDFG
DEL(CRHDENT,CRHDP,CRHDS)	;Delete a parameter value
	N CRHDERR,CRHDFG
	S CRHDFG=1
	D DEL^XPAR(CRHDENT,CRHDP,CRHDS,.CRHDERR)
	I CRHDERR>0 S CRHDFG=0
	Q CRHDFG
GET(CRHDRTN,CRHDENT,CRHDP)	;Get parameters from the parameter file
	D GETLST^XPAR(.CRHDRTN,CRHDENT,CRHDP,"E")
	Q
DELALL(CRHDENT,CRHDP)	;Delete all instances
	N CRHDERR,CRHDFG
	S CRHDFG=1
	D NDEL^XPAR(CRHDENT,CRHDP,.CRHDERR)
	I CRHDERR>0 S CRHDFG=0
	Q CRHDFG
USERDIV(CRHDRTN,CRHDDUZ)	;
	K CRHDRTN
	N CRHDX,CRHDR,CRHDC
	S CRHDC=0
	D DIV4^XUSER(.CRHDR,CRHDDUZ)
	S CRHDX=0
	F  S CRHDX=$O(CRHDR(CRHDX)) Q:'CRHDX!($D(CRHDRTN(1)))  D
	.I CRHDR(CRHDX)=1 S CRHDC=CRHDC+1,CRHDRTN(CRHDC)=CRHDX_"^"_$P($G(^DIC(4,+CRHDX,0)),"^",1)_"^1" K CRHDR(CRHDX)
	S CRHDX=0
	F  S CRHDX=$O(CRHDR(CRHDX)) Q:'CRHDX  D
	.S CRHDC=CRHDC+1
	.S CRHDRTN(CRHDC)=CRHDX_"^"_$P($G(^DIC(4,+CRHDX,0)),"^",1)_"^0"
	Q
DELPREF(CRHDRTN,CRHDE)	;delete a preference
	N Y,X,CRHDE1,CRHDE2,CRHDE3,CRHDE4,CRHDE5,DA,DR,DIE,CRHDL
	N CRHDPN
	S CRHDRTN(1)=0
	S CRHDE1=+CRHDE
	S CRHDE2=$P(CRHDE,"^",2)
	S CRHDL=$L(CRHDE,"^")
	S CRHDE3=$P(CRHDE,"^",CRHDL)
	S CRHDE4="DIV.`"_$P($P(CRHDE,"^",CRHDL),"-",2)
	S CRHDE5=CRHDE1_$S(CRHDE3="USR":";VA(200,",CRHDE3="OTL":";OR(100.21,",CRHDE3="DIV":";DIC(4,",CRHDE3="SRV":";DIC(49,",1:"")
	I CRHDE5'="" S DA=$O(^CRHD(183,"B",CRHDE5,0))
	I DA D
	.K ^CRHD(183,DA)
	.K ^CRHD(183,"B",CRHDE5)
	.K ^CRHD(183,"AC",+CRHDE5)
	.;S DIE=183,DR=".01///@" D ^DIE
	.I '$D(^CRHD(183,"B",CRHDE5)) S CRHDRTN(1)=1
	.S CRHDENT=CRHDE3_".`"_CRHDE1
	.I CRHDE3="DIV" S CRHDPN(1)="CRHD DNR ORDERABLE ITEMS",CRHDPN(2)="CRHD DNR ORDER TITLE"
	.S CRHDX=0
	.F  S CRHDX=$O(CRHDPN(CRHDX)) Q:'CRHDX  D
	..D GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN(CRHDX),"I")
	..I $G(CRHDOLST) S CRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPN(CRHDX)) K CRHDOLST
	Q