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
 
CRHDI,CRHDIEN,CRHDNAME
 
CRHDI=1,CRHDNAME=""
 
F  S CRHDNAME=$O(^DIC(49,"B",CRHDNAME)) Q:CRHDNAME=""  CRHDIEN=$O(^(CRHDNAME,0)) D
 
CRHDY(CRHDI)=CRHDIEN_"^"_CRHDNAME,CRHDI=CRHDI+1
 
Q
DIV(CRHDY) ; RETURN LIST OF INSTITUTIONS
 
CRHDI,CRHDIEN,CRHDNAME,CRHDIVST,CRHDINA
 
CRHDI=1,CRHDNAME=""
 
F  S CRHDNAME=$O(^DIC(4,"B",CRHDNAME)) Q:CRHDNAME=""  CRHDIEN=$O(^(CRHDNAME,0)) D
 
.CRHDINA=$$GET1^DIQ(4,CRHDIEN_",",101,"I")
 .
CRHDIVST=$$GET1^DIQ(4,CRHDIEN_",",11,"I")
 .
'CRHDINA 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
 
CRHDERR,CRHDFG
 
;
 
CRHDFG=1
 
PUT^XPAR(CRHDENT,CRHDP,+CRHDS,CRHDVAL,.CRHDERR)
 
CRHDERR>0 CRHDFG=0
 
CRHDFG
DEL(CRHDENT,CRHDP,CRHDS) ;Delete a parameter value
 
CRHDERR,CRHDFG
 
CRHDFG=1
 
DEL^XPAR(CRHDENT,CRHDP,CRHDS,.CRHDERR)
 
CRHDERR>0 CRHDFG=0
 
CRHDFG
GET(CRHDRTN,CRHDENT,CRHDP) ;Get parameters from the parameter file
 
GETLST^XPAR(.CRHDRTN,CRHDENT,CRHDP,"E")
 
Q
DELALL(CRHDENT,CRHDP) ;Delete all instances
 
CRHDERR,CRHDFG
 
CRHDFG=1
 
NDEL^XPAR(CRHDENT,CRHDP,.CRHDERR)
 
CRHDERR>0 CRHDFG=0
 
CRHDFG
USERDIV(CRHDRTN,CRHDDUZ) ;
 
CRHDRTN
 
CRHDX,CRHDR,CRHDC
 
CRHDC=0
 
DIV4^XUSER(.CRHDR,CRHDDUZ)
 
CRHDX=0
 
F  S CRHDX=$O(CRHDR(CRHDX)) Q:'CRHDX!($D(CRHDRTN(1)))  D
 
.CRHDR(CRHDX)=1 CRHDC=CRHDC+1,CRHDRTN(CRHDC)=CRHDX_"^"_$P($G(^DIC(4,+CRHDX,0)),"^",1)_"^1" CRHDR(CRHDX)
 
CRHDX=0
 
F  S CRHDX=$O(CRHDR(CRHDX)) Q:'CRHDX  D
 
.CRHDC=CRHDC+1
 .
CRHDRTN(CRHDC)=CRHDX_"^"_$P($G(^DIC(4,+CRHDX,0)),"^",1)_"^0"
 
Q
DELPREF(CRHDRTN,CRHDE) ;delete a preference
 
Y,X,CRHDE1,CRHDE2,CRHDE3,CRHDE4,CRHDE5,DA,DR,DIE,CRHDL
 
CRHDPN
 
CRHDRTN(1)=0
 
CRHDE1=+CRHDE
 
CRHDE2=$P(CRHDE,"^",2)
 
CRHDL=$L(CRHDE,"^")
 
CRHDE3=$P(CRHDE,"^",CRHDL)
 
CRHDE4="DIV.`"_$P($P(CRHDE,"^",CRHDL),"-",2)
 
CRHDE5=CRHDE1_$S(CRHDE3="USR":";VA(200,",CRHDE3="OTL":";OR(100.21,",CRHDE3="DIV":";DIC(4,",CRHDE3="SRV":";DIC(49,",1:"")
 
CRHDE5'="" DA=$O(^CRHD(183,"B",CRHDE5,0))
 
DA D
 
.^CRHD(183,DA)
 .
^CRHD(183,"B",CRHDE5)
 .
^CRHD(183,"AC",+CRHDE5)
 .
;S DIE=183,DR=".01///@" D ^DIE
 
.'$D(^CRHD(183,"B",CRHDE5)) CRHDRTN(1)=1
 .
CRHDENT=CRHDE3_".`"_CRHDE1
 
.CRHDE3="DIV" CRHDPN(1)="CRHD DNR ORDERABLE ITEMS",CRHDPN(2)="CRHD DNR ORDER TITLE"
 
.CRHDX=0
 .
F  S CRHDX=$O(CRHDPN(CRHDX)) Q:'CRHDX  D
 
..GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN(CRHDX),"I")
 ..
I $G(CRHDOLSTCRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPN(CRHDX)) CRHDOLST
 
Q