CRHD11 ; CAIRO/CLC - GET USERS PARAMETERS ;23-Mar-2008 13:13;CLC
;;1.0;CRHD;****;Jan 28, 2008;Build 19
;=================================================================
GETALLPL(CRHDRTN,DUZ,CRHDDIV) ;
;get a list of Parameters levels
N CRHDPAR,CRHDTEAM,CRHDSRV,Y,CRHDX,CRHDIVIE,CRHDCT,CRHDMGR
N CRHDI
D MGR^CRHD7(.CRHDMGR,+DUZ)
I +CRHDMGR D GETMGRPL(.CRHDRTN,DUZ) Q
S Y=-1
S CRHDCT=1
D TEAMS^ORWTPT(.CRHDTEAM,DUZ)
S CRHDSRV=$$GET1^DIQ(200,DUZ_",",29,"E")
S CRHDPAR="USR.`"_DUZ
D LOOKUP^XPAREDIT(CRHDPAR,183)
;I (Y>0)&($$CKATNRES(+Y)) S CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
I Y>0 S CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
I $D(CRHDTEAM) D
.S CRHDI=0
.F S CRHDI=$O(CRHDTEAM(CRHDI)) Q:'CRHDI D
..S Y=0,CRHDPAR="OTL.`"_+CRHDTEAM(CRHDI) D LOOKUP^XPAREDIT(CRHDPAR,183)
..I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
I $G(CRHDSRV)'="" S Y=0,CRHDPAR="SRV."_CRHDSRV D LOOKUP^XPAREDIT(CRHDPAR,183)
I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
S Y=0,CRHDPAR="DIV.`"_+CRHDDIV D LOOKUP^XPAREDIT(CRHDPAR,183)
I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
I (Y<0) D
.S CRHDIVIE=$O(^DIC(4,"D",CRHDDIV,0))
.I CRHDIVIE S Y=0,CRHDPAR="DIV.`"_CRHDIVIE D LOOKUP^XPAREDIT(CRHDPAR,183)
.I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
Q
GETIT(CRHDRTN,CRHDMN) ;get all of the users PARameters 2
N CRHDX2,CRHDCT,CRHDP,CRHDMGR
K CRHDRTN
S (CRHDP,CRHDCT)=0
;Q:'$$CKATNRES(+CRHDMN)
F S CRHDP=$O(^CRHD(183,+CRHDMN,1,CRHDP)) Q:'CRHDP D
.S CRHDCT=CRHDCT+1
.I $P($G(^CRHD(183,+CRHDMN,1,CRHDP,0)),"^",2)="" D
..S CRHDX2=0 F S CRHDX2=$O(^CRHD(183,+CRHDMN,1,CRHDP,1,CRHDX2)) Q:'CRHDX2 D
...S CRHDRTN(CRHDCT)=$P($G(^CRHD(183,+CRHDMN,1,CRHDP,0)),"^",1)_"^"_$G(^CRHD(183,+CRHDMN,1,CRHDP,1,CRHDX2,0))
...S CRHDCT=CRHDCT+1
.E S CRHDRTN(CRHDCT)=$G(^CRHD(183,+CRHDMN,1,CRHDP,0))
Q
CKATNRES(CRHDN) ;Check for Resident and Student fields only exist
;0 - Resident and/or Student Parameters or no Parameters exist
;1 - if full setup
;I '$D(^CRHD(183,CRHDN)) Q 0
;I $D(^CRHD(183,CRHDN,1,0))&($P(^CRHD(183,CRHDN,1,0),"^",4)>2) Q 1
;E Q 0
;
GETMGRPL(CRHDRTN,CRHDUSR) ;Get a list of preferences for Manager, excludes user levels- this could be to long
N CRHDPNAM,CRHDMN,CRHDCT,CRHDMGR
S CRHDCT=0
D MGR^CRHD7(.CRHDMGR,+CRHDUSR)
Q:'CRHDMGR
S CRHDPNAM=""
F S CRHDPNAM=$O(^CRHD(183,"B",CRHDPNAM)) Q:CRHDPNAM="" D
.S CRHDMN=0
.F S CRHDMN=$O(^CRHD(183,"B",CRHDPNAM,CRHDMN)) Q:'CRHDMN D
..;Q:'$$CKATNRES(+CRHDMN)
..;S CRHDPFMT="^"_$P(CRHDPNAM,";",2)_+CRHDPNAM_",0)"
..I CRHDPNAM[";" S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDMN_"^"_CRHDPNAM_"^"_$$GETFENT(CRHDPNAM,0,1)
Q
GETFENT(CRHDE,CRHDN,CRHDP) ;Convert to file entry
;CRHDE = entity
;CRHDN = node
;CRHDP = piece
N CRHDPFMT
S CRHDPFMT="^"_$P(CRHDE,";",2)_+CRHDE_","_CRHDN_")"
Q $P($G(@CRHDPFMT),"^",CRHDP)
DEFPREF(CRHDRTN,CRHDUSR) ;Default preference for a user
N CRHDE,CRHDOLST,CRHDX,Y,CRHDP
K CRHDRTN
S CRHDE="USR.`"_+CRHDUSR
;D GETLST^XPAR(.CRHDOLST,CRHDE,"CRHD DEFAULT PREFERENCE","E")
S CRHDOLST=$$GET^XPAR(CRHDE,"CRHD DEFAULT PREFERENCE",1,"E")
I CRHDOLST D
.I '$$GET1^DIQ(183,+CRHDOLST_",",.01,"I") D NDEL^XPAR("USR.`"_+CRHDUSR,"CRHD DEFAULT PREFERENCE") Q
.I CRHDOLST'?.E1"|".E S CRHDRTN(1)=+CRHDOLST_"^"_$$GET1^DIQ(183,+CRHDOLST_",",.01,"I")_"^"_$$GET1^DIQ(183,+CRHDOLST_",",.01,"E")_"^DEF" Q
.S CRHDRTN(1)=$P(CRHDOLST,"^",2)
.S CRHDRTN(1)=$TR(CRHDRTN(1),"|","^")_"^D"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HCRHD11 3616 printed Apr 09, 2024@21:40:11 Page 2
CRHD11 ; CAIRO/CLC - GET USERS PARAMETERS ;23-Mar-2008 13:13;CLC
+1 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
+2 ;=================================================================
GETALLPL(CRHDRTN,DUZ,CRHDDIV) ;
+1 ;get a list of Parameters levels
+2 NEW CRHDPAR,CRHDTEAM,CRHDSRV,Y,CRHDX,CRHDIVIE,CRHDCT,CRHDMGR
+3 NEW CRHDI
+4 DO MGR^CRHD7(.CRHDMGR,+DUZ)
+5 IF +CRHDMGR
DO GETMGRPL(.CRHDRTN,DUZ)
QUIT
+6 SET Y=-1
+7 SET CRHDCT=1
+8 DO TEAMS^ORWTPT(.CRHDTEAM,DUZ)
+9 SET CRHDSRV=$$GET1^DIQ(200,DUZ_",",29,"E")
+10 SET CRHDPAR="USR.`"_DUZ
+11 DO LOOKUP^XPAREDIT(CRHDPAR,183)
+12 ;I (Y>0)&($$CKATNRES(+Y)) S CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
+13 IF Y>0
SET CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($PIECE(Y,"^",2),0,1)
+14 IF $DATA(CRHDTEAM)
Begin DoDot:1
+15 SET CRHDI=0
+16 FOR
SET CRHDI=$ORDER(CRHDTEAM(CRHDI))
if 'CRHDI
QUIT
Begin DoDot:2
+17 SET Y=0
SET CRHDPAR="OTL.`"_+CRHDTEAM(CRHDI)
DO LOOKUP^XPAREDIT(CRHDPAR,183)
+18 IF Y>0
SET CRHDCT=CRHDCT+1
SET CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($PIECE(Y,"^",2),0,1)
End DoDot:2
End DoDot:1
+19 IF $GET(CRHDSRV)'=""
SET Y=0
SET CRHDPAR="SRV."_CRHDSRV
DO LOOKUP^XPAREDIT(CRHDPAR,183)
+20 IF Y>0
SET CRHDCT=CRHDCT+1
SET CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($PIECE(Y,"^",2),0,1)
+21 IF '+$GET(CRHDDIV)
SET CRHDDIV=+$$SITE^VASITE
+22 SET Y=0
SET CRHDPAR="DIV.`"_+CRHDDIV
DO LOOKUP^XPAREDIT(CRHDPAR,183)
+23 IF Y>0
SET CRHDCT=CRHDCT+1
SET CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($PIECE(Y,"^",2),0,1)
+24 IF (Y<0)
Begin DoDot:1
+25 SET CRHDIVIE=$ORDER(^DIC(4,"D",CRHDDIV,0))
+26 IF CRHDIVIE
SET Y=0
SET CRHDPAR="DIV.`"_CRHDIVIE
DO LOOKUP^XPAREDIT(CRHDPAR,183)
+27 IF Y>0
SET CRHDCT=CRHDCT+1
SET CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($PIECE(Y,"^",2),0,1)
End DoDot:1
+28 QUIT
GETIT(CRHDRTN,CRHDMN) ;get all of the users PARameters 2
+1 NEW CRHDX2,CRHDCT,CRHDP,CRHDMGR
+2 KILL CRHDRTN
+3 SET (CRHDP,CRHDCT)=0
+4 ;Q:'$$CKATNRES(+CRHDMN)
+5 FOR
SET CRHDP=$ORDER(^CRHD(183,+CRHDMN,1,CRHDP))
if 'CRHDP
QUIT
Begin DoDot:1
+6 SET CRHDCT=CRHDCT+1
+7 IF $PIECE($GET(^CRHD(183,+CRHDMN,1,CRHDP,0)),"^",2)=""
Begin DoDot:2
+8 SET CRHDX2=0
FOR
SET CRHDX2=$ORDER(^CRHD(183,+CRHDMN,1,CRHDP,1,CRHDX2))
if 'CRHDX2
QUIT
Begin DoDot:3
+9 SET CRHDRTN(CRHDCT)=$PIECE($GET(^CRHD(183,+CRHDMN,1,CRHDP,0)),"^",1)_"^"_$GET(^CRHD(183,+CRHDMN,1,CRHDP,1,CRHDX2,0))
+10 SET CRHDCT=CRHDCT+1
End DoDot:3
End DoDot:2
+11 IF '$TEST
SET CRHDRTN(CRHDCT)=$GET(^CRHD(183,+CRHDMN,1,CRHDP,0))
End DoDot:1
+12 QUIT
CKATNRES(CRHDN) ;Check for Resident and Student fields only exist
+1 ;0 - Resident and/or Student Parameters or no Parameters exist
+2 ;1 - if full setup
+3 ;I '$D(^CRHD(183,CRHDN)) Q 0
+4 ;I $D(^CRHD(183,CRHDN,1,0))&($P(^CRHD(183,CRHDN,1,0),"^",4)>2) Q 1
+5 ;E Q 0
+6 ;
GETMGRPL(CRHDRTN,CRHDUSR) ;Get a list of preferences for Manager, excludes user levels- this could be to long
+1 NEW CRHDPNAM,CRHDMN,CRHDCT,CRHDMGR
+2 SET CRHDCT=0
+3 DO MGR^CRHD7(.CRHDMGR,+CRHDUSR)
+4 if 'CRHDMGR
QUIT
+5 SET CRHDPNAM=""
+6 FOR
SET CRHDPNAM=$ORDER(^CRHD(183,"B",CRHDPNAM))
if CRHDPNAM=""
QUIT
Begin DoDot:1
+7 SET CRHDMN=0
+8 FOR
SET CRHDMN=$ORDER(^CRHD(183,"B",CRHDPNAM,CRHDMN))
if 'CRHDMN
QUIT
Begin DoDot:2
+9 ;Q:'$$CKATNRES(+CRHDMN)
+10 ;S CRHDPFMT="^"_$P(CRHDPNAM,";",2)_+CRHDPNAM_",0)"
+11 IF CRHDPNAM[";"
SET CRHDCT=CRHDCT+1
SET CRHDRTN(CRHDCT)=CRHDMN_"^"_CRHDPNAM_"^"_$$GETFENT(CRHDPNAM,0,1)
End DoDot:2
End DoDot:1
+12 QUIT
GETFENT(CRHDE,CRHDN,CRHDP) ;Convert to file entry
+1 ;CRHDE = entity
+2 ;CRHDN = node
+3 ;CRHDP = piece
+4 NEW CRHDPFMT
+5 SET CRHDPFMT="^"_$PIECE(CRHDE,";",2)_+CRHDE_","_CRHDN_")"
+6 QUIT $PIECE($GET(@CRHDPFMT),"^",CRHDP)
DEFPREF(CRHDRTN,CRHDUSR) ;Default preference for a user
+1 NEW CRHDE,CRHDOLST,CRHDX,Y,CRHDP
+2 KILL CRHDRTN
+3 SET CRHDE="USR.`"_+CRHDUSR
+4 ;D GETLST^XPAR(.CRHDOLST,CRHDE,"CRHD DEFAULT PREFERENCE","E")
+5 SET CRHDOLST=$$GET^XPAR(CRHDE,"CRHD DEFAULT PREFERENCE",1,"E")
+6 IF CRHDOLST
Begin DoDot:1
+7 IF '$$GET1^DIQ(183,+CRHDOLST_",",.01,"I")
DO NDEL^XPAR("USR.`"_+CRHDUSR,"CRHD DEFAULT PREFERENCE")
QUIT
+8 IF CRHDOLST'?.E1"|".E
SET CRHDRTN(1)=+CRHDOLST_"^"_$$GET1^DIQ(183,+CRHDOLST_",",.01,"I")_"^"_$$GET1^DIQ(183,+CRHDOLST_",",.01,"E")_"^DEF"
QUIT
+9 SET CRHDRTN(1)=$PIECE(CRHDOLST,"^",2)
+10 SET CRHDRTN(1)=$TRANSLATE(CRHDRTN(1),"|","^")_"^D"
End DoDot:1
+11 QUIT
