CRHD10 ; CAIRO/CLC - ASSIGN PROVIDERS TO A TEAM LIST ;04-Mar-2008 16:00;CLC
 ;;1.0;CRHD;****;Jan 28, 2008;Build 19
 ;=================================================================
TMDELAPV(CRHDRTN,CRHDTM) ;
 ;delete all providers from list, delete entry.
 
DA,DIK
 
CRHDRTN
 
CRHDRTN=0
 
+CRHDTM DIK="^CRHD(183.4,",DA=+CRHDTM ^DIK CRHDRTN=1
 
Q
TMLIST(CRHDRTN,CRHDTM) ;Get list of Providers for a team
 
CRHDX,CRHDPRV,CRHDTLST,CRHDCT,CRHDZ0,CRHDSORT,CRHDUT
 
CRHDI,CRHDTM6,CRHDPNAM
 
CRHDRTN
 
CRHDRTN(1)="No list found"
 
Q:'CRHDTM
 
Q:$P($G(CRHDTM),"^",2)=""
 
'$D(^CRHD(183.4,"B",$P(CRHDTM,"^",2))) Q
 S 
CRHDTM6=$O(^CRHD(183.4,"B",$P(CRHDTM,"^",2),0))
 
'CRHDTM6 CRHDRTN(1)=0 Q
 S 
CRHDX=0
 
F  S CRHDX=$O(^CRHD(183.4,+CRHDTM6,1,CRHDX)) Q:'CRHDX  D
 
.CRHDPRV=+$G(^CRHD(183.4,+CRHDTM6,1,CRHDX,0))
 .
CRHDPNAM=$$GET1^DIQ(200,+CRHDPRV,.01,"E")
 .
CRHDPNAM'="" D
 
..CRHDZ0=$G(^CRHD(183.4,+CRHDTM6,1,+CRHDX,0))
 ..
CRHDUT=$P(CRHDZ0,"^",2)
 ..
CRHDUT="" CRHDUT="ZNOTYPE"
 
..CRHDSORT(CRHDUT,CRHDPNAM)=CRHDPRV_"^"_CRHDPNAM_"^"_$P(CRHDZ0,"^",2)_"^"_$P(CRHDZ0,"^",3)_"^"_$P(CRHDZ0,"^",4)
 
CRHDI=""
 
F  S CRHDI=$O(CRHDSORT(CRHDI)) Q:CRHDI=""  D
 
.CRHDPRV=""
 
.F  S CRHDPRV=$O(CRHDSORT(CRHDI,CRHDPRV)) Q:CRHDPRV=""  D
 
..CRHDTLST(CRHDPRV)=CRHDSORT(CRHDI,CRHDPRV)
 
I $D(CRHDTLSTD
 
.CRHDCT=0
 .
CRHDX=""
 
.F  S CRHDX=$O(CRHDTLST(CRHDX)) Q:CRHDX=""  CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDTLST(CRHDX)
 
Q
TMPRVINF(CRHDRTN,CRHDTM,CRHDPHY) ;
 ;return user information
 
CRHDPRV,CRHDZ0,CRHDMGR,CRHDMN,CRHDPNAM
 
Q:CRHDTM=""
 
CRHDMN=$O(^CRHD(183.4,"B",$P(CRHDTM,"^",2),0))
 
CRHDPRV=$O(^CRHD(183.4,+CRHDMN,1,"B",+CRHDPHY,0))
 
'CRHDPRV Q
 S 
CRHDZ0=$G(^CRHD(183.4,+CRHDMN,1,+CRHDPRV,0))
 
CRHDPNAM=$$GET1^DIQ(200,+CRHDZ0,.01,"E")
 
CRHDRTN=$P(CRHDZ0,"^",1)_"^"_CRHDPNAM_"^"_$P(CRHDZ0,"^",2)_"^^^"_$P(CRHDZ0,"^",3,99)
 
Q
TMMOD(CRHDRTN,CRHDTM,CRHDTXT,CRHDKFG) ;
 
CRHDX,CRHDFDA,CRHDOUT,CRHDERR,CRHDMN,CRHDPG,CRHDPL,CRHDOP
 
CRHDRTN
 
CRHDRTN(0)=0
 
'$D(^CRHD(183.4,"B",$P(CRHDTM,"^",2),+CRHDTM)) D
 
.CRHDFDA(183.4,"?+1,",.01)=$P(CRHDTM,"^",2)
 .
UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
.'$D(CRHDERRCRHDMN=CRHDOUT(1) CRHDFDA,CRHDOUT
 
Q:'CRHDMN
 
K:CRHDKFG ^CRHD(183.4,CRHDMN,1)
 
CRHDX=0
 
F  S CRHDX=$O(CRHDTXT(CRHDX)) Q:'CRHDX  D
 
.CRHDPL=$L(CRHDTXT(CRHDX),"^"),CRHDPG=$P(CRHDTXT(CRHDX),"^",CRHDPL)
 .
CRHDOP=$P(CRHDTXT(CRHDX),"^",CRHDPL-1)
 .
CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",.01)=$P(CRHDTXT(CRHDX),"^",1)
 .
CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",1)=$P(CRHDTXT(CRHDX),"^",3)
 .
CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",2)=CRHDOP
 
.CRHDFDA(183.41,"?+"_(CRHDX+1)_","_+CRHDMN_","_"",3)=CRHDPG
 
UPDATE^DIE("","CRHDFDA","CRHDOUT","CRHDERR")
 
'$D(CRHDERRCRHDRTN(0)=1
 
E  S CRHDRTN(1)=1
 
CRHDFDA,CRHDOUT,CRHDERR
 
Q
TMCOMB(CRHDRTN) ;return list of teams for a user with a combination list
 
CRHDS,CRHDF,CRHDFN,CRHDSRC,CRHDCT
 
Q:'$G(DUZ)
 
CRHDCT=0
 
CRHDSRC=0
 
F  S CRHDSRC=$O(^OR(100.24,DUZ,.01,CRHDSRC)) Q:'CRHDSRC  D
 
.CRHDS=$G(^OR(100.24,DUZ,.01,CRHDSRC,0))
 .
CRHDS D
 
..CRHDFN=+$P($P(CRHDS,";",2),"(",2)
 ..
CRHDF=+CRHDS
 
..CRHDCT=CRHDCT+1,CRHDRTN(CRHDCT)=CRHDS_"^"_$$GET1^DIQ(CRHDFN,CRHDF,.01,"E")
 
Q