source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGLP3USR.m@ 841

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1DGLP3USR ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97
2 ;;5.3;Registration;**447**;Aug 13, 1993
3 ;
4 ; SLC/PKS - Modifications for "combinations" - 3/2000.
5 ;
6CLSTRTD ;
7 N DGLPT,PARAM
8 S DGLPT="Set Default Clinic Start Date",PARAM="DGLP DEFAULT CLINIC START DATE"
9 D PROC(DGLPT,PARAM)
10 Q
11CLSTPD ;
12 N DGLPT,PARAM
13 S DGLPT="Set Default Clinic Stop Date",PARAM="DGLP DEFAULT CLINIC STOP DATE"
14 D PROC(DGLPT,PARAM)
15 Q
16CLSUN ;
17 N DGLPT,PARAM
18 S DGLPT="Set Default Clinic Sunday",PARAM="DGLP DEFAULT CLINIC SUNDAY"
19 D PROC(DGLPT,PARAM)
20 Q
21CLMON ;
22 N DGLPT,PARAM
23 S DGLPT="Set Default Clinic Monday",PARAM="DGLP DEFAULT CLINIC MONDAY"
24 D PROC(DGLPT,PARAM)
25 Q
26CLTUE ;
27 N DGLPT,PARAM
28 S DGLPT="Set Default Clinic Tuesday",PARAM="DGLP DEFAULT CLINIC TUESDAY"
29 D PROC(DGLPT,PARAM)
30 Q
31CLWED ;
32 N DGLPT,PARAM
33 S DGLPT="Set Default Clinic Wednesday",PARAM="DGLP DEFAULT CLINIC WEDNESDAY"
34 D PROC(DGLPT,PARAM)
35 Q
36CLTHUR ;
37 N DGLPT,PARAM
38 S DGLPT="Set Defalt Clinic Thursday",PARAM="DGLP DEFAULT CLINIC THURSDAY"
39 D PROC(DGLPT,PARAM)
40 Q
41CLFRI ;
42 N DGLPT,PARAM
43 S DGLPT="Set Default Clinic Friday",PARAM="DGLP DEFAULT CLINIC FRIDAY"
44 D PROC(DGLPT,PARAM)
45 Q
46CLSAT ;
47 N DGLPT,PARAM
48 S DGLPT="Set Default Clinic Saturday",PARAM="DGLP DEFAULT CLINIC SATURDAY"
49 D PROC(DGLPT,PARAM)
50 Q
51LSTORD ;
52 N DGLPT,PARAM
53 S DGLPT="Set Default Sort Order for Patient List",PARAM="DGLP DEFAULT LIST ORDER"
54 D PROC(DGLPT,PARAM)
55 Q
56LSTSRC ;
57 N DGLPT,PARAM
58 S DGLPT="Set Default List Source",PARAM="DGLP DEFAULT LIST SOURCE"
59 D PROC(DGLPT,PARAM)
60 Q
61PROVIDER ;
62 N DGLPT,PARAM
63 S DGLPT="Set Default Primary Provider",PARAM="DGLP DEFAULT PROVIDER"
64 D PROC(DGLPT,PARAM)
65 Q
66SPEC ;
67 N DGLPT,PARAM
68 S DGLPT="Set Default Treating Specialty",PARAM="DGLP DEFAULT SPECIALTY"
69 D PROC(DGLPT,PARAM)
70 Q
71TEAM ;
72 N DGLPT,PARAM
73 S DGLPT="Set Default Team List",PARAM="DGLP DEFAULT TEAM"
74 D PROC(DGLPT,PARAM)
75 Q
76WARD ;
77 N DGLPT,PARAM
78 S DGLPT="Set Default Ward",PARAM="DGLP DEFAULT WARD"
79 D PROC(DGLPT,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 ; DGLPCNT = Holds return value from function call.
89 ; DGLPDASH = Screen "-" character write holder.
90 ; DGLPDUZ = DUZ of current user.
91 ; DGLPERR = Error array for return by DB calls.
92 ; DGLPFDA = Namespaced required DB call variable.
93 ; DGLPIEN = Array for DB call.
94 ; DGLPRTN = Holds value returned by DB calls.
95 ; DGLPUNM = Name of current user from ^VA(200, file.
96 ;
97 N DA,DIE,DR,DGLPCNT,DGLPDASH,DGLPDUZ,DGLPERR,DGLPFDA,DGLPIEN,DGLPRTN,DGLPUNM
98 ;
99 ; Find existing record for this user:
100 I '$D(DUZ) W !,"No user DUZ info." Q
101 S DGLPDUZ=DUZ
102 K DGLPERR
103 S DGLPRTN=$$FIND1^DIC(100.24,"","QX",DGLPDUZ,"","","DGLPERR")
104 K DGLPERR
105 D CLEAN^DILF ; Clean up after DB call.
106 ;
107 ; Create a record if one does not exist:
108 I DGLPRTN<1 D
109 .K DGLPERR
110 .S DGLPFDA(100.24,"+1,",.01)=DGLPDUZ
111 .S DGLPIEN(1)=DGLPDUZ ; Set up for DINUM record insertion.
112 .D UPDATE^DIE("S","DGLPFDA","DGLPIEN","DGLPERR")
113 .K DGLPFDA
114 .K DGLPERR
115 .D CLEAN^DILF ; Clean up after DB call.
116 .S DGLPRTN=$$FIND1^DIC(100.24,"","QX",DGLPDUZ,"","","DGLPERR")
117 .K DGLPERR
118 .D CLEAN^DILF ; Clean up after DB call.
119 ;
120 ; Check - record should now exist in any case:
121 I +DGLPRTN<1 W !,"Unable to create an entry for user: "_DGLPDUZ_"!" 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 DGLPCNT=0
130 S DGLPCNT=$$COMBDISP^DGQPTQ5(DGLPDUZ,+DGLPRTN)
131 I DGLPCNT=0 W !,"No current combination entries...."
132 ;
133 S DGLPUNM=$P($G(^VA(200,DGLPDUZ,0)),U,1) ; Get user's name.
134 S DGLPUNM="Setting for user: "_DGLPUNM ; Construct title string.
135 S DGLPCNT=(($S($D(IOM):IOM,1:80)-$L(DGLPUNM))\2)-2
136 S DGLPDASH=""
137 S $P(DGLPDASH,"-",DGLPCNT+1)=""
138 W !!,DGLPDASH_" "_DGLPUNM_" "_DGLPDASH ; 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=+DGLPRTN
143 S DR="1"
144 S DR(.01,100.241)=".01"
145 D ^DIE
146 ;
147 Q
148 ;
149PROC(DGLPT,PARAM) ; Process Parameter Settings
150 N ENT,PAR
151 D TITLE(DGLPT)
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(DGBT) ;
159 ; Center and write title
160 S IOP=0 D ^%ZIS K IOP W @IOF
161 W !,?(80-$L(DGBT)-1/2),DGBT
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.