| [613] | 1 | CRHD5 ; CAIRO/CLC - MISC ROUTINE FOR CAIRO HAND-OFF TOOL ;20-Mar-2008 13:28;CLC
|
|---|
| 2 | ;;1.0;CRHD;****;Jan 28, 2008;Build 19
|
|---|
| 3 | ;=================================================================
|
|---|
| 4 | SRV(CRHDY) ; RETURN LIST OF SERVICES/SECTIONS
|
|---|
| 5 | N CRHDI,CRHDIEN,CRHDNAME
|
|---|
| 6 | S CRHDI=1,CRHDNAME=""
|
|---|
| 7 | F S CRHDNAME=$O(^DIC(49,"B",CRHDNAME)) Q:CRHDNAME="" S CRHDIEN=$O(^(CRHDNAME,0)) D
|
|---|
| 8 | . S CRHDY(CRHDI)=CRHDIEN_"^"_CRHDNAME,CRHDI=CRHDI+1
|
|---|
| 9 | Q
|
|---|
| 10 | DIV(CRHDY) ; RETURN LIST OF INSTITUTIONS
|
|---|
| 11 | N CRHDI,CRHDIEN,CRHDNAME,CRHDIVST,CRHDINA
|
|---|
| 12 | S CRHDI=1,CRHDNAME=""
|
|---|
| 13 | F S CRHDNAME=$O(^DIC(4,"B",CRHDNAME)) Q:CRHDNAME="" S CRHDIEN=$O(^(CRHDNAME,0)) D
|
|---|
| 14 | .S CRHDINA=$$GET1^DIQ(4,CRHDIEN_",",101,"I")
|
|---|
| 15 | .S CRHDIVST=$$GET1^DIQ(4,CRHDIEN_",",11,"I")
|
|---|
| 16 | .I 'CRHDINA S CRHDY(CRHDI)=CRHDIEN_"^"_CRHDNAME,CRHDI=CRHDI+1
|
|---|
| 17 | Q
|
|---|
| 18 | SET(CRHDENT,CRHDP,CRHDS,CRHDVAL) ;Set the parameter
|
|---|
| 19 | ;D PUT^XPAR("DIV.`583","CRHD DNR ORDER TITLE",2,"Patient DNR Orders")
|
|---|
| 20 | ;CRHDENT=entity
|
|---|
| 21 | ;CRHDP=Parameter name
|
|---|
| 22 | ;CRHDS=Sequence (count)
|
|---|
| 23 | ;CRHDVAL=parameter value
|
|---|
| 24 | N CRHDERR,CRHDFG
|
|---|
| 25 | ;
|
|---|
| 26 | S CRHDFG=1
|
|---|
| 27 | D PUT^XPAR(CRHDENT,CRHDP,+CRHDS,CRHDVAL,.CRHDERR)
|
|---|
| 28 | I CRHDERR>0 S CRHDFG=0
|
|---|
| 29 | Q CRHDFG
|
|---|
| 30 | DEL(CRHDENT,CRHDP,CRHDS) ;Delete a parameter value
|
|---|
| 31 | N CRHDERR,CRHDFG
|
|---|
| 32 | S CRHDFG=1
|
|---|
| 33 | D DEL^XPAR(CRHDENT,CRHDP,CRHDS,.CRHDERR)
|
|---|
| 34 | I CRHDERR>0 S CRHDFG=0
|
|---|
| 35 | Q CRHDFG
|
|---|
| 36 | GET(CRHDRTN,CRHDENT,CRHDP) ;Get parameters from the parameter file
|
|---|
| 37 | D GETLST^XPAR(.CRHDRTN,CRHDENT,CRHDP,"E")
|
|---|
| 38 | Q
|
|---|
| 39 | DELALL(CRHDENT,CRHDP) ;Delete all instances
|
|---|
| 40 | N CRHDERR,CRHDFG
|
|---|
| 41 | S CRHDFG=1
|
|---|
| 42 | D NDEL^XPAR(CRHDENT,CRHDP,.CRHDERR)
|
|---|
| 43 | I CRHDERR>0 S CRHDFG=0
|
|---|
| 44 | Q CRHDFG
|
|---|
| 45 | USERDIV(CRHDRTN,CRHDDUZ) ;
|
|---|
| 46 | K CRHDRTN
|
|---|
| 47 | N CRHDX,CRHDR,CRHDC
|
|---|
| 48 | S CRHDC=0
|
|---|
| 49 | D DIV4^XUSER(.CRHDR,CRHDDUZ)
|
|---|
| 50 | S CRHDX=0
|
|---|
| 51 | F S CRHDX=$O(CRHDR(CRHDX)) Q:'CRHDX!($D(CRHDRTN(1))) D
|
|---|
| 52 | .I CRHDR(CRHDX)=1 S CRHDC=CRHDC+1,CRHDRTN(CRHDC)=CRHDX_"^"_$P($G(^DIC(4,+CRHDX,0)),"^",1)_"^1" K CRHDR(CRHDX)
|
|---|
| 53 | S CRHDX=0
|
|---|
| 54 | F S CRHDX=$O(CRHDR(CRHDX)) Q:'CRHDX D
|
|---|
| 55 | .S CRHDC=CRHDC+1
|
|---|
| 56 | .S CRHDRTN(CRHDC)=CRHDX_"^"_$P($G(^DIC(4,+CRHDX,0)),"^",1)_"^0"
|
|---|
| 57 | Q
|
|---|
| 58 | DELPREF(CRHDRTN,CRHDE) ;delete a preference
|
|---|
| 59 | N Y,X,CRHDE1,CRHDE2,CRHDE3,CRHDE4,CRHDE5,DA,DR,DIE,CRHDL
|
|---|
| 60 | N CRHDPN
|
|---|
| 61 | S CRHDRTN(1)=0
|
|---|
| 62 | S CRHDE1=+CRHDE
|
|---|
| 63 | S CRHDE2=$P(CRHDE,"^",2)
|
|---|
| 64 | S CRHDL=$L(CRHDE,"^")
|
|---|
| 65 | S CRHDE3=$P(CRHDE,"^",CRHDL)
|
|---|
| 66 | S CRHDE4="DIV.`"_$P($P(CRHDE,"^",CRHDL),"-",2)
|
|---|
| 67 | S CRHDE5=CRHDE1_$S(CRHDE3="USR":";VA(200,",CRHDE3="OTL":";OR(100.21,",CRHDE3="DIV":";DIC(4,",CRHDE3="SRV":";DIC(49,",1:"")
|
|---|
| 68 | I CRHDE5'="" S DA=$O(^CRHD(183,"B",CRHDE5,0))
|
|---|
| 69 | I DA D
|
|---|
| 70 | .K ^CRHD(183,DA)
|
|---|
| 71 | .K ^CRHD(183,"B",CRHDE5)
|
|---|
| 72 | .K ^CRHD(183,"AC",+CRHDE5)
|
|---|
| 73 | .;S DIE=183,DR=".01///@" D ^DIE
|
|---|
| 74 | .I '$D(^CRHD(183,"B",CRHDE5)) S CRHDRTN(1)=1
|
|---|
| 75 | .S CRHDENT=CRHDE3_".`"_CRHDE1
|
|---|
| 76 | .I CRHDE3="DIV" S CRHDPN(1)="CRHD DNR ORDERABLE ITEMS",CRHDPN(2)="CRHD DNR ORDER TITLE"
|
|---|
| 77 | .S CRHDX=0
|
|---|
| 78 | .F S CRHDX=$O(CRHDPN(CRHDX)) Q:'CRHDX D
|
|---|
| 79 | ..D GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN(CRHDX),"I")
|
|---|
| 80 | ..I $G(CRHDOLST) S CRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPN(CRHDX)) K CRHDOLST
|
|---|
| 81 | Q
|
|---|
