CRHD6 ; CAIRO/CLC - MISC ROUTINE FOR CAIRO HAND-OFF TOOL ;04-Mar-2008 16:00;CLC
 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
 ;=================================================================
GETP(CRHDRTN,CRHDE) ;
 
CRHDPAR,Y,CRHDX,CRHDCT,CRHDMN,CRHDP,CRHDE1,CRHDE2,CRHDE3,CRHDE4
 
CRHDX2,CRHDRSL,CRHDL,CRHDXCT,CRHDTRSL,CRHDEX,CRHDEE,CRHDXY
 
Y=-1
 
CRHDE1=+CRHDE                          ;internal entry number to file
 
CRHDE2=$P(CRHDE,"^",2)                 ;name
 
CRHDE3=$P(CRHDE,"^",3)                 ;types
 ;                                         USR - New Person
 ;                                         OTL - OE/RR Team
 ;                                         SRV - Service/Section
 ;                                         DIV-Institution;
 ;
 
CRHDCT=0
 
CRHDL=$L(CRHDE,"^")
 
CRHDE4="DIV.`"_$P($P(CRHDE,"^",CRHDL),"-",2)                  ;User Sign in Division
 
I $P(CRHDE4,"`",2)="" USERDIV^CRHD5(.CRHDEE,DUZCRHDE4="DIV.`"_$G(CRHDEE(1))
 
CRHDE3=$P($P(CRHDE,"^",CRHDL),"-",1)
 
CRHDPAR=CRHDE3_".`"_CRHDE1
 
CRHDPAR'="" LOOKUP^XPAREDIT(CRHDPAR,183)
 
Y>-1 D
 
.CRHDMN=+Y
 
.CRHDP=0
 .
F  S CRHDP=$O(^CRHD(183,CRHDMN,1,CRHDP)) Q:'CRHDP  D
 
..CRHDCT=CRHDCT+1
 ..
I $P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",2)="" D
 
...CRHDX2=0 F  S CRHDX2=$O(^CRHD(183,CRHDMN,1,CRHDP,1,CRHDX2)) Q:'CRHDX2  D
 
....CRHDRTN(CRHDCT)=$P($G(^CRHD(183,CRHDMN,1,CRHDP,0)),"^",1)_"^"_$G(^CRHD(183,CRHDMN,1,CRHDP,1,CRHDX2,0))
 ....
CRHDCT=CRHDCT+1
 ..
E  S CRHDRTN(CRHDCT)=$G(^CRHD(183,CRHDMN,1,CRHDP,0))
 
;get Temp fields expiration days
 
CRHDEX=$$GET^XPAR(CRHDE4,"CRHD TEMP FLD EXPIRE",1,"I")
 
'CRHDEX CRHDEX=2
 
CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)="TEMP_FLD_EXPIRE"_"^"_CRHDEX
 
;get dnr title and/or text
 
CRHDRSL DNRPARM^CRHDDR(.CRHDRSL,DUZ,$P($P(CRHDE,"^",CRHDL),"-",2)) D
 
.I $D(CRHDRSLD
 
..(CRHDXCT,CRHDXY)=0 F  S CRHDXY=$O(CRHDRSL(CRHDXY)) Q:'CRHDXY  D
 
...CRHDXCT=CRHDXCT+1,CRHDTRSL(CRHDXCT)=CRHDXY_"^"_$P($G(^ORD(101.43,+CRHDXY,0)),"^",1)
 .
I $D(CRHDTRSLCRHDRSL CRHDRSL=CRHDTRSL CRHDTRSL
 
I $D(CRHDRSLRTNLST("DNR_Titles"CRHDRSL
 
GET^CRHD5(.CRHDRSL,CRHDE4,"CRHD DNR ORDER TITLE")
 
I $D(CRHDRSLRTNLST("DNR_Text")
 
Q
RTNLST(CRHDTT) ;
 
I $D(CRHDRSLD
 
.CRHDX=0
 .
CRHDTT["DNR_Titles" F  S CRHDX=$O(CRHDRSL(CRHDX)) Q:'CRHDX  CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTT_"^"_CRHDRSL(CRHDX)
 .
E  F  S CRHDX=$O(CRHDRSL(CRHDX)) Q:'CRHDX  CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTT_"^"_$P(CRHDRSL(CRHDX),"^",2)
 
Q
 
;
SAVEP(CRHDRTN,CRHDE,CRHDPN,CRHDV,CRHDVAL) ;
 
CRHDENT,CRHDX,CRHDX1,CRHDOLST,CRHDFG,CRHDL
 
CRHDRTN(0)=1
 
CRHDE="" CRHDRTN(0)=0_"^Entity data not valid" Q
 S 
CRHDL=$L(CRHDE,"^")
 
+CRHDE CRHDENT=$P($P(CRHDE,"^",CRHDL),"-",1)_".`"_+CRHDE
 
CRHDPN="" CRHDPN="CRHD DNR ORDER TITLE"
 ;get all Instances of a Parameter
 
GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN,"I")
 
I $D(CRHDOLSTCRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPN)
 
I $D(CRHDVALD
 
.CRHDX=0,CRHDCT=0
 .
F  S CRHDX=$O(CRHDVAL(CRHDX)) Q:'CRHDX  D
 
..CRHDCT=CRHDCT+1
 ..
SET^CRHD5(CRHDENT,CRHDPN,CRHDCT,CRHDVAL(CRHDX))
 
Q
SAVEP2(CRHDRTN,CRHDE,CRHDPN,CRHDV,CRHDVAL) ;
 
CRHDENT,CRHDX,CRHDX1,CRHDOLST,CRHDFG,CRHDL
 
CRHDRTN(0)=1
 
CRHDE="" CRHDRTN(0)=0_"^Entity data not valid" Q
 S 
CRHDL=$L(CRHDE,"^")
 
+CRHDE CRHDENT=$P($P(CRHDE,"^",CRHDL),"-",1)_".`"_+CRHDE
 
CRHDPN="" CRHDRTN(0)=0_"^Parameter name not valid" Q     ;S PN="CRHD DNR ORDER TITLE"
 
CRHDV=""&('$D(CRHDVAL)) CRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPNCRHDRTN(0)=1 Q
 
;get all Instances of a Parameter
 
GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN,"I")
 
I $G(CRHDOLSTCRHDFG=$$DELALL^CRHD5(CRHDENT,CRHDPNCRHDOLST
 
I $D(CRHDVALD
 
.CRHDX=0,CRHDCT=0
 .
F  S CRHDX=$O(CRHDVAL(CRHDX)) Q:'CRHDX  D
 
..CRHDCT=CRHDCT+1
 ..
CRHDVAL(CRHDX)'="" D
 
...CRHDVAL(CRHDX)?1N.CRHDVAL(CRHDX)=+CRHDVAL(CRHDX)
 ...
CRHDVAL(CRHDX)?1A.CRHDVAL(CRHDX)=$P(CRHDVAL(CRHDX),"^",1)
 ..
SET^CRHD5(CRHDENT,CRHDPN,CRHDCT,CRHDVAL(CRHDX))
 
Q
GETPAR2(CRHDRTN,CRHDE,CRHDPN) ;
 ;Get XPAR parameter values
 
CRHDENT,CRHDX,CRHDX1,CRHDL,CRHDOLST,CRHDPNUM,CRHDFMT,CRHDFG
 
CRHDI
 
CRHDRTN(0)=1
 
CRHDFMT="I"
 
CRHDE="" CRHDRTN(0)=0_"^Entity data not valid" Q
 S 
CRHDL=$L(CRHDE,"^")
 
+CRHDE CRHDENT=$P($P(CRHDE,"^",CRHDL),"-",1)_".`"_+CRHDE
 
CRHDPN="" CRHDRTN(0)=0_"^Parameter name not valid" Q     ;S PN="CRHD DNR ORDER TITLE"
 ;get format code
 
CRHDPNUM=$O(^XTV(8989.51,"B",CRHDPN,0))
 
CRHDPNUM D
 
.CRHDFMT=$S(($P($G(^XTV(8989.51,CRHDPNUM,1)),"^",1)="F")!($P($G(^XTV(8989.51,CRHDPNUM,1)),"^",6)="F"):"E",1:"B")
 
;get all Instances of a Parameter
 
GETLST^XPAR(.CRHDOLST,CRHDENT,CRHDPN,CRHDFMT)
 
CRHDFMT="B" D
 
.CRHDRTN
 
.CRHDI=0
 .
F  S CRHDI=$O(CRHDOLST(CRHDI)) Q:'CRHDI  S:$G(CRHDOLST(CRHDI,"V"))'="" CRHDRTN(CRHDI)=$G(CRHDOLST(CRHDI,"V"))
 
E  K CRHDRTN D
 
.CRHDI=0
 .
F  S CRHDI=$O(CRHDOLST(CRHDI)) Q:'CRHDI  CRHDRTN(CRHDI)=$P(CRHDOLST(CRHDI),"^",2)
 
Q