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

Last change on this file since 841 was 623, checked in by George Lilly, 15 years ago

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