source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPT.m@ 1311

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

revised back to 6/30/08 version

File size: 4.0 KB
RevLine 
[623]1ORWTPT ; SLC/STAFF Personal Preference - Teams ;5/4/01 16:01
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85**;Oct 24, 2000
3 ;
4GETTEAM(USERS,TEAM) ; RPC
5 ; returns members of a team
6 N CNT,NAME,NUM,USER K USERS
7 S TEAM=+$G(TEAM),CNT=0
8 S NUM=0 F S NUM=$O(^OR(100.21,TEAM,1,NUM)) Q:NUM<1 S USER=+$G(^(NUM,0)) D
9 .S NAME=$P($G(^VA(200,USER,0)),U)
10 .I '$L(NAME) Q
11 .S CNT=CNT+1
12 .S USERS(CNT)=USER_U_NAME
13 Q
14 ;
15TEAMS(TEAMS,USER) ; from ORWTPP
16 ; returns all teams a user is a member of (exculdes personal lists)
17 N CNT,NUM,ZERO K TEAMS
18 S USER=+$G(USER),CNT=0
19 S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
20 .S ZERO=$G(^OR(100.21,NUM,0))
21 .I $P(ZERO,U,2)="P" Q
22 .S CNT=CNT+1
23 .S TEAMS(CNT)=NUM_U_ZERO
24 Q
25 ;
26PLISTS(TEAMS,USER) ; from ORWTPP
27 ; returns a user's personal lists
28 N CNT,NUM,ZERO K TEAMS
29 S USER=+$G(USER),CNT=0
30 S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
31 .S ZERO=$G(^OR(100.21,NUM,0))
32 .I $P(ZERO,U,2)'="P" Q
33 .S CNT=CNT+1
34 .S TEAMS(CNT)=NUM_U_ZERO
35 Q
36 ;
37PLTEAMS(TEAMS,USER) ; from ORWTPP
38 ; returns all teams and personal lists for a user
39 N CNT,NUM,ZERO K TEAMS
40 S USER=+$G(USER),CNT=0
41 S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
42 .S ZERO=$G(^OR(100.21,NUM,0))
43 .S CNT=CNT+1
44 .S TEAMS(CNT)=NUM_U_ZERO
45 Q
46 ;
47ATEAMS(TEAMS) ; RPC
48 ; all teams available to subscribe to
49 N CNT,NAME,NODE,NUM K TEAMS
50 S CNT=0
51 S NUM=0 F S NUM=$O(^OR(100.21,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D
52 .I $P(NODE,U,6)'="Y" Q
53 .I $P(NODE,U,2)="P" Q
54 .S CNT=CNT+1
55 .S TEAMS(CNT)=NUM_U_NODE ;$P(NODE,U)
56 Q
57 ;
58ADDLIST(OK,VALUE,USER) ; from ORWTPP
59 ; adds a user to a team
60 N DA,DIC,DLAYGO,X,Y K DA,DIC,DLAYGO
61 S USER=+$G(USER)
62 S DA=USER,DA(1)=+$G(VALUE),OK=1
63 I '$D(^OR(100.21,DA(1),0)) Q
64 S DIC(0)="LM"
65 S DLAYGO=100.212
66 S X=$P($G(^VA(200,USER,0)),U)
67 S DIC="^OR(100.21,"_DA(1)_",1,"
68 D
69 .L +^OR(100.21,DA(1)):5 I '$T Q
70 .D ^DIC
71 .L -^OR(100.21,DA(1))
72 I Y=-1 S OK=0
73 K DA,DIC,DLAYGO
74 Q
75 ;
76REMLIST(OK,VALUE,USER) ; from ORWTPP
77 ; removes a user from a team
78 N DA,DIK K DA
79 S DA=+$G(USER),DA(1)=+$G(VALUE),OK=1
80 I '$D(^OR(100.21,DA(1),0)) Q
81 S DIK="^OR(100.21,"_DA(1)_",1,"
82 D
83 .L +^OR(100.21,DA(1)):5 I '$T S OK=0 Q
84 .D ^DIK
85 .L -^OR(100.21,DA(1))
86 K DA,DIK
87 Q
88 ;
89GETCOMBO(VALUES,USER) ; from ORWTPP
90 ; get user's combo list definition
91 N CNT,IEN,NAME,NODE,NUM,SOURCE K VALUES
92 S USER=+$G(USER)
93 I '$D(^OR(100.24,USER,0)) Q
94 S CNT=0
95 S NUM=0 F S NUM=$O(^OR(100.24,USER,.01,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D
96 .I '$L(NODE) Q
97 .S IEN=+NODE,SOURCE=$P(NODE,";",2),NAME=""
98 .D
99 ..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q
100 ..I SOURCE="VA(200," S SOURCE="PROVIDER",NAME=$P($G(^VA(200,IEN,0)),U) Q
101 ..I SOURCE="DIC(45.7," S SOURCE="SPECIALTY",NAME=$P($G(^DIC(45.7,IEN,0)),U) Q
102 ..I SOURCE="OR(100.21," S SOURCE="LIST",NAME=$P($G(^OR(100.21,IEN,0)),U) Q
103 ..I SOURCE="SC(" S SOURCE="CLINIC",NAME=$P($G(^SC(IEN,0)),U) Q
104 ..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q
105 .I '$L(NAME) Q
106 .S CNT=CNT+1
107 .S VALUES(CNT)=SOURCE_U_NAME_U_IEN
108 Q
109 ;
110SETCOMBO(OK,VALUES,USER) ; from ORWTPP
111 ; set user's combo list definition
112 N CNT,DA,DIK,IEN,NUM,NVALUES,SOURCE,SOURCENM K NVALUES
113 S USER=+$G(USER),OK=1
114 I 'USER Q
115 S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
116 .S IEN=+VALUES(NUM),SOURCENM=$$UP^XLFSTR($P(VALUES(NUM),U,2)),SOURCE=""
117 .I 'IEN Q
118 .I SOURCENM="WARD" S SOURCE=";DIC(42,"
119 .I SOURCENM="PROVIDER" S SOURCE=";VA(200,"
120 .I SOURCENM="SPECIALTY" S SOURCE=";DIC(45.7,"
121 .I SOURCENM="LIST" S SOURCE=";OR(100.21,"
122 .I SOURCENM="CLINIC" S SOURCE=";SC("
123 .I '$L(SOURCE) Q
124 .S NVALUES(NUM)=IEN_SOURCE
125 I '$D(^OR(100.24,USER,0)) D I '$D(^OR(100.24,USER,0)) Q
126 .L +^OR(100.24,0):5 I '$T S OK=0 Q
127 .S ^OR(100.24,USER,0)=USER
128 .S $P(^OR(100.24,0),U,4)=$P(^OR(100.24,0),U,4)+1,$P(^(0),U,3)=USER
129 .L -^OR(100.24,0)
130 S CNT=0,DA=USER,DIK="^OR(100.24,"
131 L +^OR(100.24,USER,0):5 I '$T Q
132 K ^OR(100.24,USER,.01)
133 S NUM=0 F S NUM=$O(NVALUES(NUM)) Q:NUM<1 D
134 .S CNT=CNT+1
135 .S ^OR(100.24,USER,.01,CNT,0)=NVALUES(NUM)
136 S ^OR(100.24,USER,.01,0)="^100.241V^"_CNT_U_CNT
137 D IX1^DIK
138 L -^OR(100.24,USER,0)
139 K NVALUES
140 Q
Note: See TracBrowser for help on using the repository browser.