82 lines
2.8 KiB
Mathematica
82 lines
2.8 KiB
Mathematica
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
|