Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: CRHD10

CRHD10.m

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