ORWTPT ; SLC/STAFF Personal Preference - Teams ;5/4/01 15:55
;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,243**;Oct 24, 2000;Build 242
;
GETTEAM(USERS,TEAM) ; RPC
; returns members of a team
N CNT,NAME,NUM,USER K USERS
S TEAM=+$G(TEAM),CNT=0
S NUM=0 F S NUM=$O(^OR(100.21,TEAM,1,NUM)) Q:NUM<1 S USER=+$G(^(NUM,0)) D
.S NAME=$P($G(^VA(200,USER,0)),U)
.I '$L(NAME) Q
.S CNT=CNT+1
.S USERS(CNT)=USER_U_NAME
Q
;
TEAMS(TEAMS,USER) ; from ORWTPP
; returns all teams a user is a member of (exculdes personal lists)
N CNT,NUM,ZERO K TEAMS
S USER=+$G(USER),CNT=0
S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
.S ZERO=$G(^OR(100.21,NUM,0))
.I $P(ZERO,U,2)="P" Q
.S CNT=CNT+1
.S TEAMS(CNT)=NUM_U_ZERO
Q
;
PLISTS(TEAMS,USER) ; from ORWTPP
; returns a user's personal lists
N CNT,NUM,ZERO K TEAMS
S USER=+$G(USER),CNT=0
S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
.S ZERO=$G(^OR(100.21,NUM,0))
.I $P(ZERO,U,2)'="P" Q
.S CNT=CNT+1
.N VIS S VIS=$P($G(^OR(100.21,NUM,11)),U)
.I '$L(VIS) S VIS=1
.S TEAMS(CNT)=NUM_U_ZERO_U_VIS
Q
;
PLTEAMS(TEAMS,USER) ; from ORWTPP
; returns all teams and personal lists for a user
N CNT,NUM,ZERO K TEAMS
S USER=+$G(USER),CNT=0
S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
.S ZERO=$G(^OR(100.21,NUM,0))
.S CNT=CNT+1
.S TEAMS(CNT)=NUM_U_ZERO
Q
;
ATEAMS(TEAMS) ; RPC
; all teams available to subscribe to
N CNT,NAME,NODE,NUM K TEAMS
S CNT=0
S NUM=0 F S NUM=$O(^OR(100.21,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D
.I $P(NODE,U,6)'="Y" Q
.I $P(NODE,U,2)="P" Q
.S CNT=CNT+1
.S TEAMS(CNT)=NUM_U_NODE ;$P(NODE,U)
Q
;
ADDLIST(OK,VALUE,USER) ; from ORWTPP
; adds a user to a team
N DA,DIC,DLAYGO,X,Y K DA,DIC,DLAYGO
S USER=+$G(USER)
S DA=USER,DA(1)=+$G(VALUE),OK=1
I '$D(^OR(100.21,DA(1),0)) Q
S DIC(0)="LM"
S DLAYGO=100.212
S X=$P($G(^VA(200,USER,0)),U)
S DIC="^OR(100.21,"_DA(1)_",1,"
D
.L +^OR(100.21,DA(1)):5 I '$T Q
.D ^DIC
.L -^OR(100.21,DA(1))
I Y=-1 S OK=0
K DA,DIC,DLAYGO
Q
;
REMLIST(OK,VALUE,USER) ; from ORWTPP
; removes a user from a team
N DA,DIK K DA
S DA=+$G(USER),DA(1)=+$G(VALUE),OK=1
I '$D(^OR(100.21,DA(1),0)) Q
S DIK="^OR(100.21,"_DA(1)_",1,"
D
.L +^OR(100.21,DA(1)):5 I '$T S OK=0 Q
.D ^DIK
.L -^OR(100.21,DA(1))
K DA,DIK
Q
;
GETCOMBO(VALUES,USER) ; from ORWTPP
; get user's combo list definition
N CNT,IEN,NAME,NODE,NUM,SOURCE K VALUES
S USER=+$G(USER)
I '$D(^OR(100.24,USER,0)) Q
S CNT=0
S NUM=0 F S NUM=$O(^OR(100.24,USER,.01,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D
.I '$L(NODE) Q
.S IEN=+NODE,SOURCE=$P(NODE,";",2),NAME=""
.D
..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q
..I SOURCE="VA(200," S SOURCE="PROVIDER",NAME=$P($G(^VA(200,IEN,0)),U) Q
..I SOURCE="DIC(45.7," S SOURCE="SPECIALTY",NAME=$P($G(^DIC(45.7,IEN,0)),U) Q
..I SOURCE="OR(100.21," S SOURCE="LIST",NAME=$P($G(^OR(100.21,IEN,0)),U) Q
..I SOURCE="SC(" S SOURCE="CLINIC",NAME=$P($G(^SC(IEN,0)),U) Q
..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q
.I '$L(NAME) Q
.S CNT=CNT+1
.S VALUES(CNT)=SOURCE_U_NAME_U_IEN
Q
;
SETCOMBO(OK,VALUES,USER) ; from ORWTPP
; set user's combo list definition
N CNT,DA,DIK,IEN,NUM,NVALUES,SOURCE,SOURCENM K NVALUES
S USER=+$G(USER),OK=1
I 'USER Q
S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
.S IEN=+VALUES(NUM),SOURCENM=$$UP^XLFSTR($P(VALUES(NUM),U,2)),SOURCE=""
.I 'IEN Q
.I SOURCENM="WARD" S SOURCE=";DIC(42,"
.I SOURCENM="PROVIDER" S SOURCE=";VA(200,"
.I SOURCENM="SPECIALTY" S SOURCE=";DIC(45.7,"
.I SOURCENM="LIST" S SOURCE=";OR(100.21,"
.I SOURCENM="CLINIC" S SOURCE=";SC("
.I '$L(SOURCE) Q
.S NVALUES(NUM)=IEN_SOURCE
I '$D(^OR(100.24,USER,0)) D I '$D(^OR(100.24,USER,0)) Q
.L +^OR(100.24,0):5 I '$T S OK=0 Q
.S ^OR(100.24,USER,0)=USER
.S $P(^OR(100.24,0),U,4)=$P(^OR(100.24,0),U,4)+1,$P(^(0),U,3)=USER
.L -^OR(100.24,0)
S CNT=0,DA=USER,DIK="^OR(100.24,"
L +^OR(100.24,USER,0):5 I '$T Q
K ^OR(100.24,USER,.01)
S NUM=0 F S NUM=$O(NVALUES(NUM)) Q:NUM<1 D
.S CNT=CNT+1
.S ^OR(100.24,USER,.01,CNT,0)=NVALUES(NUM)
S ^OR(100.24,USER,.01,0)="^100.241V^"_CNT_U_CNT
D IX1^DIK
L -^OR(100.24,USER,0)
K NVALUES
Q
ORWTPT ; SLC/STAFF Personal Preference - Teams ;5/4/01 15:55
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,243**;Oct 24, 2000;Build 242
+2 ;
GETTEAM(USERS,TEAM) ; RPC
+1 ; returns members of a team
+2 NEW CNT,NAME,NUM,USER
KILL USERS
+3 SET TEAM=+$GET(TEAM)
SET CNT=0
+4 SET NUM=0
FOR
SET NUM=$ORDER(^OR(100.21,TEAM,1,NUM))
IF NUM<1
QUIT
SET USER=+$GET(^(NUM,0))
Begin DoDot:1
+5 SET NAME=$PIECE($GET(^VA(200,USER,0)),U)
+6 IF '$LENGTH(NAME)
QUIT
+7 SET CNT=CNT+1
+8 SET USERS(CNT)=USER_U_NAME
End DoDot:1
+9 QUIT
+10 ;
TEAMS(TEAMS,USER) ; from ORWTPP
+1 ; returns all teams a user is a member of (exculdes personal lists)
+2 NEW CNT,NUM,ZERO
KILL TEAMS
+3 SET USER=+$GET(USER)
SET CNT=0
+4 SET NUM=0
FOR
SET NUM=$ORDER(^OR(100.21,"C",USER,NUM))
IF NUM<1
QUIT
Begin DoDot:1
+5 SET ZERO=$GET(^OR(100.21,NUM,0))
+6 IF $PIECE(ZERO,U,2)="P"
QUIT
+7 SET CNT=CNT+1
+8 SET TEAMS(CNT)=NUM_U_ZERO
End DoDot:1
+9 QUIT
+10 ;
PLISTS(TEAMS,USER) ; from ORWTPP
+1 ; returns a user's personal lists
+2 NEW CNT,NUM,ZERO
KILL TEAMS
+3 SET USER=+$GET(USER)
SET CNT=0
+4 SET NUM=0
FOR
SET NUM=$ORDER(^OR(100.21,"C",USER,NUM))
IF NUM<1
QUIT
Begin DoDot:1
+5 SET ZERO=$GET(^OR(100.21,NUM,0))
+6 IF $PIECE(ZERO,U,2)'="P"
QUIT
+7 SET CNT=CNT+1
+8 NEW VIS
SET VIS=$PIECE($GET(^OR(100.21,NUM,11)),U)
+9 IF '$LENGTH(VIS)
SET VIS=1
+10 SET TEAMS(CNT)=NUM_U_ZERO_U_VIS
End DoDot:1
+11 QUIT
+12 ;
PLTEAMS(TEAMS,USER) ; from ORWTPP
+1 ; returns all teams and personal lists for a user
+2 NEW CNT,NUM,ZERO
KILL TEAMS
+3 SET USER=+$GET(USER)
SET CNT=0
+4 SET NUM=0
FOR
SET NUM=$ORDER(^OR(100.21,"C",USER,NUM))
IF NUM<1
QUIT
Begin DoDot:1
+5 SET ZERO=$GET(^OR(100.21,NUM,0))
+6 SET CNT=CNT+1
+7 SET TEAMS(CNT)=NUM_U_ZERO
End DoDot:1
+8 QUIT
+9 ;
ATEAMS(TEAMS) ; RPC
+1 ; all teams available to subscribe to
+2 NEW CNT,NAME,NODE,NUM
KILL TEAMS
+3 SET CNT=0
+4 SET NUM=0
FOR
SET NUM=$ORDER(^OR(100.21,NUM))
IF NUM<1
QUIT
SET NODE=$GET(^(NUM,0))
Begin DoDot:1
+5 IF $PIECE(NODE,U,6)'="Y"
QUIT
+6 IF $PIECE(NODE,U,2)="P"
QUIT
+7 SET CNT=CNT+1
+8 ;$P(NODE,U)
SET TEAMS(CNT)=NUM_U_NODE
End DoDot:1
+9 QUIT
+10 ;
ADDLIST(OK,VALUE,USER) ; from ORWTPP
+1 ; adds a user to a team
+2 NEW DA,DIC,DLAYGO,X,Y
KILL DA,DIC,DLAYGO
+3 SET USER=+$GET(USER)
+4 SET DA=USER
SET DA(1)=+$GET(VALUE)
SET OK=1
+5 IF '$DATA(^OR(100.21,DA(1),0))
QUIT
+6 SET DIC(0)="LM"
+7 SET DLAYGO=100.212
+8 SET X=$PIECE($GET(^VA(200,USER,0)),U)
+9 SET DIC="^OR(100.21,"_DA(1)_",1,"
+10 Begin DoDot:1
+11 LOCK +^OR(100.21,DA(1)):5
IF '$TEST
QUIT
+12 DO ^DIC
+13 LOCK -^OR(100.21,DA(1))
End DoDot:1
+14 IF Y=-1
SET OK=0
+15 KILL DA,DIC,DLAYGO
+16 QUIT
+17 ;
REMLIST(OK,VALUE,USER) ; from ORWTPP
+1 ; removes a user from a team
+2 NEW DA,DIK
KILL DA
+3 SET DA=+$GET(USER)
SET DA(1)=+$GET(VALUE)
SET OK=1
+4 IF '$DATA(^OR(100.21,DA(1),0))
QUIT
+5 SET DIK="^OR(100.21,"_DA(1)_",1,"
+6 Begin DoDot:1
+7 LOCK +^OR(100.21,DA(1)):5
IF '$TEST
SET OK=0
QUIT
+8 DO ^DIK
+9 LOCK -^OR(100.21,DA(1))
End DoDot:1
+10 KILL DA,DIK
+11 QUIT
+12 ;
GETCOMBO(VALUES,USER) ; from ORWTPP
+1 ; get user's combo list definition
+2 NEW CNT,IEN,NAME,NODE,NUM,SOURCE
KILL VALUES
+3 SET USER=+$GET(USER)
+4 IF '$DATA(^OR(100.24,USER,0))
QUIT
+5 SET CNT=0
+6 SET NUM=0
FOR
SET NUM=$ORDER(^OR(100.24,USER,.01,NUM))
IF NUM<1
QUIT
SET NODE=$GET(^(NUM,0))
Begin DoDot:1
+7 IF '$LENGTH(NODE)
QUIT
+8 SET IEN=+NODE
SET SOURCE=$PIECE(NODE,";",2)
SET NAME=""
+9 Begin DoDot:2
+10 IF SOURCE="DIC(42,"
SET SOURCE="WARD"
SET NAME=$PIECE($GET(^DIC(42,IEN,0)),U)
QUIT
+11 IF SOURCE="VA(200,"
SET SOURCE="PROVIDER"
SET NAME=$PIECE($GET(^VA(200,IEN,0)),U)
QUIT
+12 IF SOURCE="DIC(45.7,"
SET SOURCE="SPECIALTY"
SET NAME=$PIECE($GET(^DIC(45.7,IEN,0)),U)
QUIT
+13 IF SOURCE="OR(100.21,"
SET SOURCE="LIST"
SET NAME=$PIECE($GET(^OR(100.21,IEN,0)),U)
QUIT
+14 IF SOURCE="SC("
SET SOURCE="CLINIC"
SET NAME=$PIECE($GET(^SC(IEN,0)),U)
QUIT
+15 IF SOURCE="DIC(42,"
SET SOURCE="WARD"
SET NAME=$PIECE($GET(^DIC(42,IEN,0)),U)
QUIT
End DoDot:2
+16 IF '$LENGTH(NAME)
QUIT
+17 SET CNT=CNT+1
+18 SET VALUES(CNT)=SOURCE_U_NAME_U_IEN
End DoDot:1
+19 QUIT
+20 ;
SETCOMBO(OK,VALUES,USER) ; from ORWTPP
+1 ; set user's combo list definition
+2 NEW CNT,DA,DIK,IEN,NUM,NVALUES,SOURCE,SOURCENM
KILL NVALUES
+3 SET USER=+$GET(USER)
SET OK=1
+4 IF 'USER
QUIT
+5 SET NUM=0
FOR
SET NUM=$ORDER(VALUES(NUM))
IF NUM<1
QUIT
Begin DoDot:1
+6 SET IEN=+VALUES(NUM)
SET SOURCENM=$$UP^XLFSTR($PIECE(VALUES(NUM),U,2))
SET SOURCE=""
+7 IF 'IEN
QUIT
+8 IF SOURCENM="WARD"
SET SOURCE=";DIC(42,"
+9 IF SOURCENM="PROVIDER"
SET SOURCE=";VA(200,"
+10 IF SOURCENM="SPECIALTY"
SET SOURCE=";DIC(45.7,"
+11 IF SOURCENM="LIST"
SET SOURCE=";OR(100.21,"
+12 IF SOURCENM="CLINIC"
SET SOURCE=";SC("
+13 IF '$LENGTH(SOURCE)
QUIT
+14 SET NVALUES(NUM)=IEN_SOURCE
End DoDot:1
+15 IF '$DATA(^OR(100.24,USER,0))
Begin DoDot:1
+16 LOCK +^OR(100.24,0):5
IF '$TEST
SET OK=0
QUIT
+17 SET ^OR(100.24,USER,0)=USER
+18 SET $PIECE(^OR(100.24,0),U,4)=$PIECE(^OR(100.24,0),U,4)+1
SET $PIECE(^(0),U,3)=USER
+19 LOCK -^OR(100.24,0)
End DoDot:1
IF '$DATA(^OR(100.24,USER,0))
QUIT
+20 SET CNT=0
SET DA=USER
SET DIK="^OR(100.24,"
+21 LOCK +^OR(100.24,USER,0):5
IF '$TEST
QUIT
+22 KILL ^OR(100.24,USER,.01)
+23 SET NUM=0
FOR
SET NUM=$ORDER(NVALUES(NUM))
IF NUM<1
QUIT
Begin DoDot:1
+24 SET CNT=CNT+1
+25 SET ^OR(100.24,USER,.01,CNT,0)=NVALUES(NUM)
End DoDot:1
+26 SET ^OR(100.24,USER,.01,0)="^100.241V^"_CNT_U_CNT
+27 DO IX1^DIK
+28 LOCK -^OR(100.24,USER,0)
+29 KILL NVALUES
+30 QUIT
