source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP3USR.m@ 1087

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1ORLP3USR ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97 [9/12/00 12:17pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,82**;Dec 17, 1997
3 ;
4 ; SLC/PKS - Modifications for "combinations" - 3/2000.
5 ;
6CLSTRTD ;
7 N ORLPT,PARAM
8 S ORLPT="Set Default Clinic Start Date",PARAM="ORLP DEFAULT CLINIC START DATE"
9 D PROC(ORLPT,PARAM)
10 Q
11CLSTPD ;
12 N ORLPT,PARAM
13 S ORLPT="Set Default Clinic Stop Date",PARAM="ORLP DEFAULT CLINIC STOP DATE"
14 D PROC(ORLPT,PARAM)
15 Q
16CLSUN ;
17 N ORLPT,PARAM
18 S ORLPT="Set Default Clinic Sunday",PARAM="ORLP DEFAULT CLINIC SUNDAY"
19 D PROC(ORLPT,PARAM)
20 Q
21CLMON ;
22 N ORLPT,PARAM
23 S ORLPT="Set Default Clinic Monday",PARAM="ORLP DEFAULT CLINIC MONDAY"
24 D PROC(ORLPT,PARAM)
25 Q
26CLTUE ;
27 N ORLPT,PARAM
28 S ORLPT="Set Default Clinic Tuesday",PARAM="ORLP DEFAULT CLINIC TUESDAY"
29 D PROC(ORLPT,PARAM)
30 Q
31CLWED ;
32 N ORLPT,PARAM
33 S ORLPT="Set Default Clinic Wednesday",PARAM="ORLP DEFAULT CLINIC WEDNESDAY"
34 D PROC(ORLPT,PARAM)
35 Q
36CLTHUR ;
37 N ORLPT,PARAM
38 S ORLPT="Set Defalt Clinic Thursday",PARAM="ORLP DEFAULT CLINIC THURSDAY"
39 D PROC(ORLPT,PARAM)
40 Q
41CLFRI ;
42 N ORLPT,PARAM
43 S ORLPT="Set Default Clinic Friday",PARAM="ORLP DEFAULT CLINIC FRIDAY"
44 D PROC(ORLPT,PARAM)
45 Q
46CLSAT ;
47 N ORLPT,PARAM
48 S ORLPT="Set Default Clinic Saturday",PARAM="ORLP DEFAULT CLINIC SATURDAY"
49 D PROC(ORLPT,PARAM)
50 Q
51LSTORD ;
52 N ORLPT,PARAM
53 S ORLPT="Set Default Sort Order for Patient List",PARAM="ORLP DEFAULT LIST ORDER"
54 D PROC(ORLPT,PARAM)
55 Q
56LSTSRC ;
57 N ORLPT,PARAM
58 S ORLPT="Set Default List Source",PARAM="ORLP DEFAULT LIST SOURCE"
59 D PROC(ORLPT,PARAM)
60 Q
61PROVIDER ;
62 N ORLPT,PARAM
63 S ORLPT="Set Default Primary Provider",PARAM="ORLP DEFAULT PROVIDER"
64 D PROC(ORLPT,PARAM)
65 Q
66SPEC ;
67 N ORLPT,PARAM
68 S ORLPT="Set Default Treating Specialty",PARAM="ORLP DEFAULT SPECIALTY"
69 D PROC(ORLPT,PARAM)
70 Q
71TEAM ;
72 N ORLPT,PARAM
73 S ORLPT="Set Default Team List",PARAM="ORLP DEFAULT TEAM"
74 D PROC(ORLPT,PARAM)
75 Q
76WARD ;
77 N ORLPT,PARAM
78 S ORLPT="Set Default Ward",PARAM="ORLP DEFAULT WARD"
79 D PROC(ORLPT,PARAM)
80 Q
81 ;
82COMB ; Set default combination sources.
83 ; SLC/PKS - 3/2000
84 ;
85 ; Variables used:
86 ;
87 ; DA,DIE,DR = DIE variables.
88 ; ORLPCNT = Holds return value from function call.
89 ; ORLPDASH = Screen "-" character write holder.
90 ; ORLPDUZ = DUZ of current user.
91 ; ORLPERR = Error array for return by DB calls.
92 ; ORLPFDA = Namespaced required DB call variable.
93 ; ORLPIEN = Array for DB call.
94 ; ORLPRTN = Holds value returned by DB calls.
95 ; ORLPUNM = Name of current user from ^VA(200, file.
96 ;
97 N DA,DIE,DR,ORLPCNT,ORLPDASH,ORLPDUZ,ORLPERR,ORLPFDA,ORLPIEN,ORLPRTN,ORLPUNM
98 ;
99 ; Find existing record for this user:
100 I '$D(DUZ) W !,"No user DUZ info." Q
101 S ORLPDUZ=DUZ
102 K ORLPERR
103 S ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
104 K ORLPERR
105 D CLEAN^DILF ; Clean up after DB call.
106 ;
107 ; Create a record if one does not exist:
108 I ORLPRTN<1 D
109 .K ORLPERR
110 .S ORLPFDA(100.24,"+1,",.01)=ORLPDUZ
111 .S ORLPIEN(1)=ORLPDUZ ; Set up for DINUM record insertion.
112 .D UPDATE^DIE("S","ORLPFDA","ORLPIEN","ORLPERR")
113 .K ORLPFDA
114 .K ORLPERR
115 .D CLEAN^DILF ; Clean up after DB call.
116 .S ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
117 .K ORLPERR
118 .D CLEAN^DILF ; Clean up after DB call.
119 ;
120 ; Check - record should now exist in any case:
121 I +ORLPRTN<1 W !,"Unable to create an entry for user: "_ORLPDUZ_"!" Q
122 ;
123 ; Display title for existing entries:
124 D TITLE("Set Default Combination")
125 W !,$$DASH($S($D(IOM):IOM-1,1:78))
126 W !!," Your current combination entries are:",!
127 ;
128 ; Make a call to tag that displays existing entries:
129 S ORLPCNT=0
130 S ORLPCNT=$$COMBDISP^ORQPTQ5(ORLPDUZ,+ORLPRTN)
131 I ORLPCNT=0 W !,"No current combination entries...."
132 ;
133 S ORLPUNM=$P($G(^VA(200,ORLPDUZ,0)),U,1) ; Get user's name.
134 S ORLPUNM="Setting for user: "_ORLPUNM ; Construct title string.
135 S ORLPCNT=(($S($D(IOM):IOM,1:80)-$L(ORLPUNM))\2)-2
136 S ORLPDASH=""
137 S $P(ORLPDASH,"-",ORLPCNT+1)=""
138 W !!,ORLPDASH_" "_ORLPUNM_" "_ORLPDASH ; Write title w/dashes.
139 ;
140 ; Set variables and call DIE to allow user editing of combination:
141 S DIE="^OR(100.24,"
142 S DA=+ORLPRTN
143 S DR="1"
144 S DR(.01,100.241)=".01"
145 D ^DIE
146 ;
147 Q
148 ;
149PROC(ORLPT,PARAM) ; Process Parameter Settings
150 N ENT,PAR
151 D TITLE(ORLPT)
152 S PAR=$O(^XTV(8989.51,"B",PARAM,0)) Q:PAR=""
153 S ENT=DUZ_";VA(200," ; Entity is the user
154 W !,$$DASH($S($D(IOM):IOM-1,1:78))
155 D EDIT^XPAREDIT(ENT,PAR)
156 Q
157 ;
158TITLE(ORBT) ;
159 ; Center and write title
160 S IOP=0 D ^%ZIS K IOP W @IOF
161 W !,?(80-$L(ORBT)-1/2),ORBT
162 Q
163 ;
164DASH(N) ;extrinsic function returns N dashes
165 N X
166 S $P(X,"-",N+1)=""
167 Q X
168XCHGPOS ; exchange the users associated with positions/teams
169 Q
Note: See TracBrowser for help on using the repository browser.