source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/CRHD10.m@ 1764

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1CRHD10 ; CAIRO/CLC - ASSIGN PROVIDERS TO A TEAM LIST ;04-Mar-2008 16:00;CLC
2 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
3 ;=================================================================
4TMDELAPV(CRHDRTN,CRHDTM) ;
5 ;delete all providers from list, delete entry.
6 N DA,DIK
7 K CRHDRTN
8 S CRHDRTN=0
9 I +CRHDTM S DIK="^CRHD(183.4,",DA=+CRHDTM D ^DIK S CRHDRTN=1
10 Q
11TMLIST(CRHDRTN,CRHDTM) ;Get list of Providers for a team
12 N CRHDX,CRHDPRV,CRHDTLST,CRHDCT,CRHDZ0,CRHDSORT,CRHDUT
13 N CRHDI,CRHDTM6,CRHDPNAM
14 K CRHDRTN
15 S CRHDRTN(1)="No list found"
16 Q:'CRHDTM
17 Q:$P($G(CRHDTM),"^",2)=""
18 I '$D(^CRHD(183.4,"B",$P(CRHDTM,"^",2))) Q
19 S CRHDTM6=$O(^CRHD(183.4,"B",$P(CRHDTM,"^",2),0))
20 I 'CRHDTM6 S CRHDRTN(1)=0 Q
21 S CRHDX=0
22 F S CRHDX=$O(^CRHD(183.4,+CRHDTM6,1,CRHDX)) Q:'CRHDX D
23 .S CRHDPRV=+$G(^CRHD(183.4,+CRHDTM6,1,CRHDX,0))
24 .S CRHDPNAM=$$GET1^DIQ(200,+CRHDPRV,.01,"E")
25 .I CRHDPNAM'="" D
26 ..S CRHDZ0=$G(^CRHD(183.4,+CRHDTM6,1,+CRHDX,0))
27 ..S CRHDUT=$P(CRHDZ0,"^",2)
28 ..I CRHDUT="" S CRHDUT="ZNOTYPE"
29 ..S CRHDSORT(CRHDUT,CRHDPNAM)=CRHDPRV_"^"_CRHDPNAM_"^"_$P(CRHDZ0,"^",2)_"^"_$P(CRHDZ0,"^",3)_"^"_$P(CRHDZ0,"^",4)
30 S CRHDI=""
31 F S CRHDI=$O(CRHDSORT(CRHDI)) Q:CRHDI="" D
32 .S CRHDPRV=""
33 .F S CRHDPRV=$O(CRHDSORT(CRHDI,CRHDPRV)) Q:CRHDPRV="" D
34 ..S CRHDTLST(CRHDPRV)=CRHDSORT(CRHDI,CRHDPRV)
35 I $D(CRHDTLST) D
36 .S CRHDCT=0
37 .S CRHDX=""
38 .F S CRHDX=$O(CRHDTLST(CRHDX)) Q:CRHDX="" S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTLST(CRHDX)
39 Q
40TMPRVINF(CRHDRTN,CRHDTM,CRHDPHY) ;
41 ;return user information
42 N CRHDPRV,CRHDZ0,CRHDMGR,CRHDMN,CRHDPNAM
43 Q:CRHDTM=""
44 S CRHDMN=$O(^CRHD(183.4,"B",$P(CRHDTM,"^",2),0))
45 S CRHDPRV=$O(^CRHD(183.4,+CRHDMN,1,"B",+CRHDPHY,0))
46 I 'CRHDPRV Q
47 S CRHDZ0=$G(^CRHD(183.4,+CRHDMN,1,+CRHDPRV,0))
48 S CRHDPNAM=$$GET1^DIQ(200,+CRHDZ0,.01,"E")
49 S CRHDRTN=$P(CRHDZ0,"^",1)_"^"_CRHDPNAM_"^"_$P(CRHDZ0,"^",2)_"^^^"_$P(CRHDZ0,"^",3,99)
50 Q
51TMMOD(CRHDRTN,CRHDTM,CRHDTXT,CRHDKFG) ;
52 N CRHDX,CRHDFDA,CRHDOUT,CRHDERR,CRHDMN,CRHDPG,CRHDPL,CRHDOP
53 K CRHDRTN
54 S CRHDRTN(0)=0
55 I '$D(^CRHD(183.4,"B",$P(CRHDTM,"^",2),+CRHDTM)) D
56 .S CRHDFDA(183.4,"?+1,",.01)=$P(CRHDTM,"^",2)
57 .D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
58A .I '$D(CRHDERR) S CRHDMN=CRHDOUT(1) K CRHDFDA,CRHDOUT
59 Q:'CRHDMN
60 K:CRHDKFG ^CRHD(183.4,CRHDMN,1)
61 S CRHDX=0
62 F S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX D
63 .S CRHDPL=$L(CRHDTXT(CRHDX),"^"),CRHDPG=$P(CRHDTXT(CRHDX),"^",CRHDPL)
64 .S CRHDOP=$P(CRHDTXT(CRHDX),"^",CRHDPL-1)
65 .S CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",.01)=$P(CRHDTXT(CRHDX),"^",1)
66 .S CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",1)=$P(CRHDTXT(CRHDX),"^",3)
67 .S CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",2)=CRHDOP
68 .S CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",3)=CRHDPG
69 D UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
70 I '$D(CRHDERR) S CRHDRTN(0)=1
71 E S CRHDRTN(1)=1
72 K CRHDFDA,CRHDOUT,CRHDERR
73 Q
74TMCOMB(CRHDRTN) ;return list of teams for a user with a combination list
75 N CRHDS,CRHDF,CRHDFN,CRHDSRC,CRHDCT
76 Q:'$G(DUZ)
77 S CRHDCT=0
78 S CRHDSRC=0
79 F S CRHDSRC=$O(^OR(100.24,DUZ,.01,CRHDSRC)) Q:'CRHDSRC D
80 .S CRHDS=$G(^OR(100.24,DUZ,.01,CRHDSRC,0))
81 .I CRHDS D
82 ..S CRHDFN=+$P($P(CRHDS,";",2),"(",2)
83 ..S CRHDF=+CRHDS
84 ..S CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDS_"^"_$$GET1^DIQ(CRHDFN,CRHDF,.01,"E")
85 Q
Note: See TracBrowser for help on using the repository browser.