- 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 Feb 19, 2025@00:04:12 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