source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWTPL.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1ORWTPL ; SLC/STAFF Personal Preference - Lists ; 3/11/08 6:36am
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,109,173,243**;Oct 24, 2000;Build 242
3 ;
4NEWLIST(VAL,LISTNAME,USER,ORVIZ) ; from ORWTPP
5 ; set user's new personal list
6 S LISTNAME=$G(LISTNAME)
7 I '$L(LISTNAME) S VAL="^invalid list name" Q
8 I $O(^OR(100.21,"B",LISTNAME,0)) S VAL="^invalid list name - duplicate of another name" Q
9 ;*** check input transform, duplicate name for same user
10 N DA,DIK,NUM
11 L +^OR(100.21,0):20 I '$T S VAL="^unable to set up" Q
12 S NUM=1+$P(^OR(100.21,0),U,3)
13 F Q:'$D(^OR(100.21,NUM,0)) S NUM=NUM+1
14 S $P(^OR(100.21,0),U,3)=NUM,$P(^(0),U,4)=$P(^(0),U,4)+1
15 S ^OR(100.21,NUM,0)=LISTNAME_"^P"
16 L -^OR(100.21,0)
17 K ^OR(100.21,NUM,1),^(2),^(10)
18 S ^OR(100.21,NUM,1,0)="^100.212PA^"_USER_"^1"
19 S ^OR(100.21,NUM,1,USER,0)=USER
20 S ^OR(100.21,NUM,11)=$G(ORVIZ)_U
21 S DIK="^OR(100.21,",DA=NUM
22 D IX1^DIK
23 S VAL=NUM_U_LISTNAME_"^^^^^^^"_$G(ORVIZ)
24 Q
25 ;
26DELLIST(OK,LISTNUM,USER) ; from ORWTPP
27 ; delete user's personal list
28 N DA,DIK
29 S LISTNUM=+$G(LISTNUM),OK=1
30 I '$O(^OR(100.21,"C",USER,LISTNUM,0)) S OK=0 Q
31 I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q
32 S DA=LISTNUM,DIK="^OR(100.21,"
33 D ^DIK
34 Q
35 ;
36SAVELIST(OK,PLIST,LISTNUM,USER,ORVIZ) ; from ORWTPP
37 ; save user's personal list changes
38 N CNT,DA,DFN,DIK,NUM K DA
39 S LISTNUM=+$G(LISTNUM),OK=1
40 I $P($G(^OR(100.21,LISTNUM,0)),U,2)'="P" S OK=0 Q
41 I '$D(^OR(100.21,"C",USER,LISTNUM)) S OK=0 Q
42 I '$D(^OR(100.21,LISTNUM,10,0))#2 S ^(0)="^100.2101AV^"
43 S DA(1)=LISTNUM,DIK="^OR(100.21,"_LISTNUM_",10,"
44 S DA=0 F S DA=$O(^OR(100.21,LISTNUM,10,DA)) Q:DA<1 D ^DIK
45 K DA
46 S CNT=0
47 S NUM=0 F S NUM=$O(PLIST(NUM)) Q:NUM<1 D
48 .S DFN=+PLIST(NUM) I 'DFN Q
49 .S CNT=CNT+1
50 .S ^OR(100.21,LISTNUM,10,CNT,0)=DFN_";DPT("
51 S ^OR(100.21,LISTNUM,10,0)="^100.2101AV^"_CNT_U_CNT
52 S ^OR(100.21,LISTNUM,11)=$G(ORVIZ)_U
53 S DA=LISTNUM,DIK="^OR(100.21,"
54 D IX1^DIK
55 Q
56 ;
57LSDEF(INFO,USER) ; from ORWTPP
58 ; get user's list sources
59 N TYPE
60 S INFO=""
61 F TYPE="P","S","T","W","C" D
62 .S INFO=INFO_$P($$LISTSRC^ORQPTQ11(USER,TYPE),U)_U
63 Q
64 ;
65SORTDEF(SORT,USER) ; from ORWTPP
66 ; get user's sort order - Modified by PKS - 8/30/2001
67 N ORSECT
68 S ORSECT=$G(^VA(200,USER,5))
69 I +ORSECT>0 S ORSECT=$P(ORSECT,U)
70 S SORT=$$GET^XPAR("USR.`"_USER_"^SRV.`"_$G(ORSECT)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I") I SORT']"" S SORT="A"
71 Q
72 ;
73CLDAYS(DAYS,USER) ; from ORWTPP
74 ; get user's clinic defaults
75 N DAY
76 S DAYS=""
77 F DAY="MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","SUNDAY" D
78 .S DAYS=DAYS_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_DAY,1,"I")_U
79 Q
80 ;
81CLRANGE(RANGE,USER) ; from ORWTPP
82 ; get user's default clinic start, stop dates
83 N RNG
84 S RANGE=""
85 F RNG="START","STOP" D
86 .S RANGE=RANGE_$$GET^XPAR("USR.`"_USER,"ORLP DEFAULT CLINIC "_RNG_" DATE",1,"I")_U
87 Q
88 ;
89SAVECD(OK,INFO,USER) ; from ORWTPP
90 ; save user's clinic defaults
91 N FRI,MON,SAT,START,STOP,SUN,THURS,TUES,WED
92 S OK=1
93 S START=+$P(INFO,U,1) S START=$S(START=0:"T",START<0:"T"_START,1:"T+"_START)
94 S STOP=+$P(INFO,U,2) S STOP=$S(STOP=0:"T",STOP<0:"T"_STOP,1:"T+"_STOP)
95 S MON=+$P(INFO,U,3),MON=$S('MON:"@",1:"`"_MON)
96 S TUES=+$P(INFO,U,4),TUES=$S('TUES:"@",1:"`"_TUES)
97 S WED=+$P(INFO,U,5),WED=$S('WED:"@",1:"`"_WED)
98 S THURS=+$P(INFO,U,6),THURS=$S('THURS:"@",1:"`"_THURS)
99 S FRI=+$P(INFO,U,7),FRI=$S('FRI:"@",1:"`"_FRI)
100 S SAT=+$P(INFO,U,8),SAT=$S('SAT:"@",1:"`"_SAT)
101 S SUN=+$P(INFO,U,9),SUN=$S('SUN:"@",1:"`"_SUN)
102 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC START DATE",1,START)
103 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC STOP DATE",1,STOP)
104 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC MONDAY",1,MON)
105 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC TUESDAY",1,TUES)
106 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC WEDNESDAY",1,WED)
107 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC THURSDAY",1,THURS)
108 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC FRIDAY",1,FRI)
109 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SATURDAY",1,SAT)
110 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT CLINIC SUNDAY",1,SUN)
111 Q
112 ;
113SAVEPLD(OK,INFO,USER) ; from ORWTPP
114 ; save user's clinic defaults
115 N PROV,SORT,SOURCE,SPEC,TEAM,WARD
116 S OK=1
117 S SOURCE=$P(INFO,U,1)
118 S SORT=$P(INFO,U,2)
119 S PROV=+$P(INFO,U,3),PROV=$S('PROV:"@",1:"`"_PROV)
120 S SPEC=+$P(INFO,U,4),SPEC=$S('SPEC:"@",1:"`"_SPEC)
121 S TEAM=+$P(INFO,U,5),TEAM=$S('TEAM:"@",1:"`"_TEAM)
122 S WARD=+$P(INFO,U,6),WARD=$S('WARD:"@",1:"`"_WARD)
123 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST SOURCE",1,SOURCE)
124 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT LIST ORDER",1,SORT)
125 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT PROVIDER",1,PROV)
126 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT SPECIALTY",1,SPEC)
127 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT TEAM",1,TEAM)
128 D EN^XPAR(USER_";VA(200,","ORLP DEFAULT WARD",1,WARD)
129 Q
Note: See TracBrowser for help on using the repository browser.