| 1 | ORWTPT ; SLC/STAFF Personal Preference - Teams ;5/4/01 16:01
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85**;Oct 24, 2000
|
|---|
| 3 | ;
|
|---|
| 4 | GETTEAM(USERS,TEAM) ; RPC
|
|---|
| 5 | ; returns members of a team
|
|---|
| 6 | N CNT,NAME,NUM,USER K USERS
|
|---|
| 7 | S TEAM=+$G(TEAM),CNT=0
|
|---|
| 8 | S NUM=0 F S NUM=$O(^OR(100.21,TEAM,1,NUM)) Q:NUM<1 S USER=+$G(^(NUM,0)) D
|
|---|
| 9 | .S NAME=$P($G(^VA(200,USER,0)),U)
|
|---|
| 10 | .I '$L(NAME) Q
|
|---|
| 11 | .S CNT=CNT+1
|
|---|
| 12 | .S USERS(CNT)=USER_U_NAME
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | TEAMS(TEAMS,USER) ; from ORWTPP
|
|---|
| 16 | ; returns all teams a user is a member of (exculdes personal lists)
|
|---|
| 17 | N CNT,NUM,ZERO K TEAMS
|
|---|
| 18 | S USER=+$G(USER),CNT=0
|
|---|
| 19 | S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
|
|---|
| 20 | .S ZERO=$G(^OR(100.21,NUM,0))
|
|---|
| 21 | .I $P(ZERO,U,2)="P" Q
|
|---|
| 22 | .S CNT=CNT+1
|
|---|
| 23 | .S TEAMS(CNT)=NUM_U_ZERO
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PLISTS(TEAMS,USER) ; from ORWTPP
|
|---|
| 27 | ; returns a user's personal lists
|
|---|
| 28 | N CNT,NUM,ZERO K TEAMS
|
|---|
| 29 | S USER=+$G(USER),CNT=0
|
|---|
| 30 | S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
|
|---|
| 31 | .S ZERO=$G(^OR(100.21,NUM,0))
|
|---|
| 32 | .I $P(ZERO,U,2)'="P" Q
|
|---|
| 33 | .S CNT=CNT+1
|
|---|
| 34 | .S TEAMS(CNT)=NUM_U_ZERO
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | PLTEAMS(TEAMS,USER) ; from ORWTPP
|
|---|
| 38 | ; returns all teams and personal lists for a user
|
|---|
| 39 | N CNT,NUM,ZERO K TEAMS
|
|---|
| 40 | S USER=+$G(USER),CNT=0
|
|---|
| 41 | S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D
|
|---|
| 42 | .S ZERO=$G(^OR(100.21,NUM,0))
|
|---|
| 43 | .S CNT=CNT+1
|
|---|
| 44 | .S TEAMS(CNT)=NUM_U_ZERO
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ATEAMS(TEAMS) ; RPC
|
|---|
| 48 | ; all teams available to subscribe to
|
|---|
| 49 | N CNT,NAME,NODE,NUM K TEAMS
|
|---|
| 50 | S CNT=0
|
|---|
| 51 | S NUM=0 F S NUM=$O(^OR(100.21,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D
|
|---|
| 52 | .I $P(NODE,U,6)'="Y" Q
|
|---|
| 53 | .I $P(NODE,U,2)="P" Q
|
|---|
| 54 | .S CNT=CNT+1
|
|---|
| 55 | .S TEAMS(CNT)=NUM_U_NODE ;$P(NODE,U)
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ADDLIST(OK,VALUE,USER) ; from ORWTPP
|
|---|
| 59 | ; adds a user to a team
|
|---|
| 60 | N DA,DIC,DLAYGO,X,Y K DA,DIC,DLAYGO
|
|---|
| 61 | S USER=+$G(USER)
|
|---|
| 62 | S DA=USER,DA(1)=+$G(VALUE),OK=1
|
|---|
| 63 | I '$D(^OR(100.21,DA(1),0)) Q
|
|---|
| 64 | S DIC(0)="LM"
|
|---|
| 65 | S DLAYGO=100.212
|
|---|
| 66 | S X=$P($G(^VA(200,USER,0)),U)
|
|---|
| 67 | S DIC="^OR(100.21,"_DA(1)_",1,"
|
|---|
| 68 | D
|
|---|
| 69 | .L +^OR(100.21,DA(1)):5 I '$T Q
|
|---|
| 70 | .D ^DIC
|
|---|
| 71 | .L -^OR(100.21,DA(1))
|
|---|
| 72 | I Y=-1 S OK=0
|
|---|
| 73 | K DA,DIC,DLAYGO
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | REMLIST(OK,VALUE,USER) ; from ORWTPP
|
|---|
| 77 | ; removes a user from a team
|
|---|
| 78 | N DA,DIK K DA
|
|---|
| 79 | S DA=+$G(USER),DA(1)=+$G(VALUE),OK=1
|
|---|
| 80 | I '$D(^OR(100.21,DA(1),0)) Q
|
|---|
| 81 | S DIK="^OR(100.21,"_DA(1)_",1,"
|
|---|
| 82 | D
|
|---|
| 83 | .L +^OR(100.21,DA(1)):5 I '$T S OK=0 Q
|
|---|
| 84 | .D ^DIK
|
|---|
| 85 | .L -^OR(100.21,DA(1))
|
|---|
| 86 | K DA,DIK
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | GETCOMBO(VALUES,USER) ; from ORWTPP
|
|---|
| 90 | ; get user's combo list definition
|
|---|
| 91 | N CNT,IEN,NAME,NODE,NUM,SOURCE K VALUES
|
|---|
| 92 | S USER=+$G(USER)
|
|---|
| 93 | I '$D(^OR(100.24,USER,0)) Q
|
|---|
| 94 | S CNT=0
|
|---|
| 95 | S NUM=0 F S NUM=$O(^OR(100.24,USER,.01,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D
|
|---|
| 96 | .I '$L(NODE) Q
|
|---|
| 97 | .S IEN=+NODE,SOURCE=$P(NODE,";",2),NAME=""
|
|---|
| 98 | .D
|
|---|
| 99 | ..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q
|
|---|
| 100 | ..I SOURCE="VA(200," S SOURCE="PROVIDER",NAME=$P($G(^VA(200,IEN,0)),U) Q
|
|---|
| 101 | ..I SOURCE="DIC(45.7," S SOURCE="SPECIALTY",NAME=$P($G(^DIC(45.7,IEN,0)),U) Q
|
|---|
| 102 | ..I SOURCE="OR(100.21," S SOURCE="LIST",NAME=$P($G(^OR(100.21,IEN,0)),U) Q
|
|---|
| 103 | ..I SOURCE="SC(" S SOURCE="CLINIC",NAME=$P($G(^SC(IEN,0)),U) Q
|
|---|
| 104 | ..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q
|
|---|
| 105 | .I '$L(NAME) Q
|
|---|
| 106 | .S CNT=CNT+1
|
|---|
| 107 | .S VALUES(CNT)=SOURCE_U_NAME_U_IEN
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | SETCOMBO(OK,VALUES,USER) ; from ORWTPP
|
|---|
| 111 | ; set user's combo list definition
|
|---|
| 112 | N CNT,DA,DIK,IEN,NUM,NVALUES,SOURCE,SOURCENM K NVALUES
|
|---|
| 113 | S USER=+$G(USER),OK=1
|
|---|
| 114 | I 'USER Q
|
|---|
| 115 | S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D
|
|---|
| 116 | .S IEN=+VALUES(NUM),SOURCENM=$$UP^XLFSTR($P(VALUES(NUM),U,2)),SOURCE=""
|
|---|
| 117 | .I 'IEN Q
|
|---|
| 118 | .I SOURCENM="WARD" S SOURCE=";DIC(42,"
|
|---|
| 119 | .I SOURCENM="PROVIDER" S SOURCE=";VA(200,"
|
|---|
| 120 | .I SOURCENM="SPECIALTY" S SOURCE=";DIC(45.7,"
|
|---|
| 121 | .I SOURCENM="LIST" S SOURCE=";OR(100.21,"
|
|---|
| 122 | .I SOURCENM="CLINIC" S SOURCE=";SC("
|
|---|
| 123 | .I '$L(SOURCE) Q
|
|---|
| 124 | .S NVALUES(NUM)=IEN_SOURCE
|
|---|
| 125 | I '$D(^OR(100.24,USER,0)) D I '$D(^OR(100.24,USER,0)) Q
|
|---|
| 126 | .L +^OR(100.24,0):5 I '$T S OK=0 Q
|
|---|
| 127 | .S ^OR(100.24,USER,0)=USER
|
|---|
| 128 | .S $P(^OR(100.24,0),U,4)=$P(^OR(100.24,0),U,4)+1,$P(^(0),U,3)=USER
|
|---|
| 129 | .L -^OR(100.24,0)
|
|---|
| 130 | S CNT=0,DA=USER,DIK="^OR(100.24,"
|
|---|
| 131 | L +^OR(100.24,USER,0):5 I '$T Q
|
|---|
| 132 | K ^OR(100.24,USER,.01)
|
|---|
| 133 | S NUM=0 F S NUM=$O(NVALUES(NUM)) Q:NUM<1 D
|
|---|
| 134 | .S CNT=CNT+1
|
|---|
| 135 | .S ^OR(100.24,USER,.01,CNT,0)=NVALUES(NUM)
|
|---|
| 136 | S ^OR(100.24,USER,.01,0)="^100.241V^"_CNT_U_CNT
|
|---|
| 137 | D IX1^DIK
|
|---|
| 138 | L -^OR(100.24,USER,0)
|
|---|
| 139 | K NVALUES
|
|---|
| 140 | Q
|
|---|
