source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/CRHD11.m@ 841

Last change on this file since 841 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1CRHD11 ; CAIRO/CLC - GET USERS PARAMETERS ;23-Mar-2008 13:13;CLC
2 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
3 ;=================================================================
4GETALLPL(CRHDRTN,DUZ,CRHDDIV) ;
5 ;get a list of Parameters levels
6 N CRHDPAR,CRHDTEAM,CRHDSRV,Y,CRHDX,CRHDIVIE,CRHDCT,CRHDMGR
7 N CRHDI
8 D MGR^CRHD7(.CRHDMGR,+DUZ)
9 I +CRHDMGR D GETMGRPL(.CRHDRTN,DUZ) Q
10 S Y=-1
11 S CRHDCT=1
12 D TEAMS^ORWTPT(.CRHDTEAM,DUZ)
13 S CRHDSRV=$$GET1^DIQ(200,DUZ_",",29,"E")
14 S CRHDPAR="USR.`"_DUZ
15 D LOOKUP^XPAREDIT(CRHDPAR,183)
16 ;I (Y>0)&($$CKATNRES(+Y)) S CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
17 I Y>0 S CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
18 I $D(CRHDTEAM) D
19 .S CRHDI=0
20 .F S CRHDI=$O(CRHDTEAM(CRHDI)) Q:'CRHDI D
21 ..S Y=0,CRHDPAR="OTL.`"_+CRHDTEAM(CRHDI) D LOOKUP^XPAREDIT(CRHDPAR,183)
22 ..I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
23 I $G(CRHDSRV)'="" S Y=0,CRHDPAR="SRV."_CRHDSRV D LOOKUP^XPAREDIT(CRHDPAR,183)
24 I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
25 I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
26 S Y=0,CRHDPAR="DIV.`"_+CRHDDIV D LOOKUP^XPAREDIT(CRHDPAR,183)
27 I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
28 I (Y<0) D
29 .S CRHDIVIE=$O(^DIC(4,"D",CRHDDIV,0))
30 .I CRHDIVIE S Y=0,CRHDPAR="DIV.`"_CRHDIVIE D LOOKUP^XPAREDIT(CRHDPAR,183)
31 .I Y>0 S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=Y_"^"_$$GETFENT($P(Y,"^",2),0,1)
32 Q
33GETIT(CRHDRTN,CRHDMN) ;get all of the users PARameters 2
34 N CRHDX2,CRHDCT,CRHDP,CRHDMGR
35 K CRHDRTN
36 S (CRHDP,CRHDCT)=0
37 ;Q:'$$CKATNRES(+CRHDMN)
38 F S CRHDP=$O(^CRHD(183,+CRHDMN,1,CRHDP)) Q:'CRHDP D
39 .S CRHDCT=CRHDCT+1
40 .I $P($G(^CRHD(183,+CRHDMN,1,CRHDP,0)),"^",2)="" D
41 ..S CRHDX2=0 F S CRHDX2=$O(^CRHD(183,+CRHDMN,1,CRHDP,1,CRHDX2)) Q:'CRHDX2 D
42 ...S CRHDRTN(CRHDCT)=$P($G(^CRHD(183,+CRHDMN,1,CRHDP,0)),"^",1)_"^"_$G(^CRHD(183,+CRHDMN,1,CRHDP,1,CRHDX2,0))
43 ...S CRHDCT=CRHDCT+1
44 .E S CRHDRTN(CRHDCT)=$G(^CRHD(183,+CRHDMN,1,CRHDP,0))
45 Q
46CKATNRES(CRHDN) ;Check for Resident and Student fields only exist
47 ;0 - Resident and/or Student Parameters or no Parameters exist
48 ;1 - if full setup
49 ;I '$D(^CRHD(183,CRHDN)) Q 0
50 ;I $D(^CRHD(183,CRHDN,1,0))&($P(^CRHD(183,CRHDN,1,0),"^",4)>2) Q 1
51 ;E Q 0
52 ;
53GETMGRPL(CRHDRTN,CRHDUSR) ;Get a list of preferences for Manager, excludes user levels- this could be to long
54 N CRHDPNAM,CRHDMN,CRHDCT,CRHDMGR
55 S CRHDCT=0
56 D MGR^CRHD7(.CRHDMGR,+CRHDUSR)
57 Q:'CRHDMGR
58 S CRHDPNAM=""
59 F S CRHDPNAM=$O(^CRHD(183,"B",CRHDPNAM)) Q:CRHDPNAM="" D
60 .S CRHDMN=0
61 .F S CRHDMN=$O(^CRHD(183,"B",CRHDPNAM,CRHDMN)) Q:'CRHDMN D
62 ..;Q:'$$CKATNRES(+CRHDMN)
63 ..;S CRHDPFMT="^"_$P(CRHDPNAM,";",2)_+CRHDPNAM_",0)"
64 ..I CRHDPNAM[";" S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDMN_"^"_CRHDPNAM_"^"_$$GETFENT(CRHDPNAM,0,1)
65 Q
66GETFENT(CRHDE,CRHDN,CRHDP) ;Convert to file entry
67 ;CRHDE = entity
68 ;CRHDN = node
69 ;CRHDP = piece
70 N CRHDPFMT
71 S CRHDPFMT="^"_$P(CRHDE,";",2)_+CRHDE_","_CRHDN_")"
72 Q $P($G(@CRHDPFMT),"^",CRHDP)
73DEFPREF(CRHDRTN,CRHDUSR) ;Default preference for a user
74 N CRHDE,CRHDOLST,CRHDX,Y,CRHDP
75 K CRHDRTN
76 S CRHDE="USR.`"_+CRHDUSR
77 ;D GETLST^XPAR(.CRHDOLST,CRHDE,"CRHD DEFAULT PREFERENCE","E")
78 S CRHDOLST=$$GET^XPAR(CRHDE,"CRHD DEFAULT PREFERENCE",1,"E")
79 I CRHDOLST D
80 .I '$$GET1^DIQ(183,+CRHDOLST_",",.01,"I") D NDEL^XPAR("USR.`"_+CRHDUSR,"CRHD DEFAULT PREFERENCE") Q
81 .I CRHDOLST'?.E1"|".E S CRHDRTN(1)=+CRHDOLST_"^"_$$GET1^DIQ(183,+CRHDOLST_",",.01,"I")_"^"_$$GET1^DIQ(183,+CRHDOLST_",",.01,"E")_"^DEF" Q
82 .S CRHDRTN(1)=$P(CRHDOLST,"^",2)
83 .S CRHDRTN(1)=$TR(CRHDRTN(1),"|","^")_"^D"
84 Q
Note: See TracBrowser for help on using the repository browser.