- 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
