- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPT.m
r613 r623 1 ORWTPT ; SLC/STAFF Personal Preference - Teams ;5/4/01 15:55 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,243**;Oct 24, 2000;Build 242 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 .N VIS S VIS=$P($G(^OR(100.21,NUM,11)),U) 35 .I '$L(VIS) S VIS=1 36 .S TEAMS(CNT)=NUM_U_ZERO_U_VIS 37 Q 38 ; 39 PLTEAMS(TEAMS,USER) ; from ORWTPP 40 ; returns all teams and personal lists for a user 41 N CNT,NUM,ZERO K TEAMS 42 S USER=+$G(USER),CNT=0 43 S NUM=0 F S NUM=$O(^OR(100.21,"C",USER,NUM)) Q:NUM<1 D 44 .S ZERO=$G(^OR(100.21,NUM,0)) 45 .S CNT=CNT+1 46 .S TEAMS(CNT)=NUM_U_ZERO 47 Q 48 ; 49 ATEAMS(TEAMS) ; RPC 50 ; all teams available to subscribe to 51 N CNT,NAME,NODE,NUM K TEAMS 52 S CNT=0 53 S NUM=0 F S NUM=$O(^OR(100.21,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D 54 .I $P(NODE,U,6)'="Y" Q 55 .I $P(NODE,U,2)="P" Q 56 .S CNT=CNT+1 57 .S TEAMS(CNT)=NUM_U_NODE ;$P(NODE,U) 58 Q 59 ; 60 ADDLIST(OK,VALUE,USER) ; from ORWTPP 61 ; adds a user to a team 62 N DA,DIC,DLAYGO,X,Y K DA,DIC,DLAYGO 63 S USER=+$G(USER) 64 S DA=USER,DA(1)=+$G(VALUE),OK=1 65 I '$D(^OR(100.21,DA(1),0)) Q 66 S DIC(0)="LM" 67 S DLAYGO=100.212 68 S X=$P($G(^VA(200,USER,0)),U) 69 S DIC="^OR(100.21,"_DA(1)_",1," 70 D 71 .L +^OR(100.21,DA(1)):5 I '$T Q 72 .D ^DIC 73 .L -^OR(100.21,DA(1)) 74 I Y=-1 S OK=0 75 K DA,DIC,DLAYGO 76 Q 77 ; 78 REMLIST(OK,VALUE,USER) ; from ORWTPP 79 ; removes a user from a team 80 N DA,DIK K DA 81 S DA=+$G(USER),DA(1)=+$G(VALUE),OK=1 82 I '$D(^OR(100.21,DA(1),0)) Q 83 S DIK="^OR(100.21,"_DA(1)_",1," 84 D 85 .L +^OR(100.21,DA(1)):5 I '$T S OK=0 Q 86 .D ^DIK 87 .L -^OR(100.21,DA(1)) 88 K DA,DIK 89 Q 90 ; 91 GETCOMBO(VALUES,USER) ; from ORWTPP 92 ; get user's combo list definition 93 N CNT,IEN,NAME,NODE,NUM,SOURCE K VALUES 94 S USER=+$G(USER) 95 I '$D(^OR(100.24,USER,0)) Q 96 S CNT=0 97 S NUM=0 F S NUM=$O(^OR(100.24,USER,.01,NUM)) Q:NUM<1 S NODE=$G(^(NUM,0)) D 98 .I '$L(NODE) Q 99 .S IEN=+NODE,SOURCE=$P(NODE,";",2),NAME="" 100 .D 101 ..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q 102 ..I SOURCE="VA(200," S SOURCE="PROVIDER",NAME=$P($G(^VA(200,IEN,0)),U) Q 103 ..I SOURCE="DIC(45.7," S SOURCE="SPECIALTY",NAME=$P($G(^DIC(45.7,IEN,0)),U) Q 104 ..I SOURCE="OR(100.21," S SOURCE="LIST",NAME=$P($G(^OR(100.21,IEN,0)),U) Q 105 ..I SOURCE="SC(" S SOURCE="CLINIC",NAME=$P($G(^SC(IEN,0)),U) Q 106 ..I SOURCE="DIC(42," S SOURCE="WARD",NAME=$P($G(^DIC(42,IEN,0)),U) Q 107 .I '$L(NAME) Q 108 .S CNT=CNT+1 109 .S VALUES(CNT)=SOURCE_U_NAME_U_IEN 110 Q 111 ; 112 SETCOMBO(OK,VALUES,USER) ; from ORWTPP 113 ; set user's combo list definition 114 N CNT,DA,DIK,IEN,NUM,NVALUES,SOURCE,SOURCENM K NVALUES 115 S USER=+$G(USER),OK=1 116 I 'USER Q 117 S NUM=0 F S NUM=$O(VALUES(NUM)) Q:NUM<1 D 118 .S IEN=+VALUES(NUM),SOURCENM=$$UP^XLFSTR($P(VALUES(NUM),U,2)),SOURCE="" 119 .I 'IEN Q 120 .I SOURCENM="WARD" S SOURCE=";DIC(42," 121 .I SOURCENM="PROVIDER" S SOURCE=";VA(200," 122 .I SOURCENM="SPECIALTY" S SOURCE=";DIC(45.7," 123 .I SOURCENM="LIST" S SOURCE=";OR(100.21," 124 .I SOURCENM="CLINIC" S SOURCE=";SC(" 125 .I '$L(SOURCE) Q 126 .S NVALUES(NUM)=IEN_SOURCE 127 I '$D(^OR(100.24,USER,0)) D I '$D(^OR(100.24,USER,0)) Q 128 .L +^OR(100.24,0):5 I '$T S OK=0 Q 129 .S ^OR(100.24,USER,0)=USER 130 .S $P(^OR(100.24,0),U,4)=$P(^OR(100.24,0),U,4)+1,$P(^(0),U,3)=USER 131 .L -^OR(100.24,0) 132 S CNT=0,DA=USER,DIK="^OR(100.24," 133 L +^OR(100.24,USER,0):5 I '$T Q 134 K ^OR(100.24,USER,.01) 135 S NUM=0 F S NUM=$O(NVALUES(NUM)) Q:NUM<1 D 136 .S CNT=CNT+1 137 .S ^OR(100.24,USER,.01,CNT,0)=NVALUES(NUM) 138 S ^OR(100.24,USER,.01,0)="^100.241V^"_CNT_U_CNT 139 D IX1^DIK 140 L -^OR(100.24,USER,0) 141 K NVALUES 142 Q 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
Note:
See TracChangeset
for help on using the changeset viewer.
