source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWU1.m@ 1240

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

initial load of WorldVistAEHR
File size: 8.0 KB
RevLine 
[613]1ORWU1 ;SLC/GRE - General Utilities for Windows Calls [2/25/04 11:10am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**149,187,195,215**;Dec 17, 1997
3 ;
4 Q
5 ;
6NP1 ; Return a set of names from the NEW PERSON file.
7 ; (PKS/8/5/2003: Now called by NEWPERS^ORWU; internal mods made.)
8 ; (Keep GETCOS^ORWTPN up to date with matching logic/code, too.)
9 ;
10 ; PARAMS from NEWPERS^ORWU call:
11 ; .ORY=returned list.
12 ; ORDATE=Checks for an active person class on this date (optional).
13 ; ORDIR=Direction to move through the x-ref with $O.
14 ; ORFROM=Starting name for this set.
15 ; ORKEY=Screen users by security key (optional).
16 ; ORVIZ=If true, includes RDV users; otherwise not (optional).
17 ;
18 N ORDD,ORDIV,ORDUP,ORGOOD,ORI,ORIEN1,ORIEN2,ORLAST,ORMAX,ORMRK,ORMULTI,ORPREV,ORSRV,ORTTL
19 ;
20 S ORI=0,ORMAX=44,(ORLAST,ORPREV)="",ORKEY=$G(ORKEY),ORDATE=$G(ORDATE)
21 S ORMULTI=$$ALL^VASITE ; IA# 10112. Do once at beginning of call.
22 ;
23 ; NP3 tag includes visitors, uses full "B" x-ref.
24 I +$G(ORVIZ)=1 D NP3(0) Q ; Use alt. version, skip rest.
25 ; User requested ALL users, both active and inactive. Same call, but skip $$PROVIDER^XUSER screen
26 I +$G(ORALL)=1 D NP3(0) Q
27 ;
28 F Q:ORI'<ORMAX S ORFROM=$O(^VA(200,"AUSER",ORFROM),ORDIR) Q:ORFROM="" D
29 .S ORIEN1=""
30 .F S ORIEN1=$O(^VA(200,"AUSER",ORFROM,ORIEN1),ORDIR) Q:'ORIEN1 D
31 ..;
32 ..I $L(ORKEY),'$D(^XUSEC(ORKEY,+ORIEN1)) Q ; Check for key?
33 ..I ORDATE>0,$$GET^XUA4A72(ORIEN1,ORDATE)<1 Q ; Check date?
34 ..S ORI=ORI+1,ORY(ORI)=ORIEN1_"^"_$$NAMEFMT^XLFNAME(ORFROM,"F","DcMPC")
35 ..S ORDUP=0 ; Init flag, check dupe.
36 ..I ($P(ORPREV_" "," ")=$P(ORFROM_" "," ")) S ORDUP=1
37 ..;
38 ..; Append Title if not duplicated:
39 ..I 'ORDUP D
40 ...S ORIEN2=ORIEN1
41 ...D NP4(0) ; Get Title.
42 ...I ORTTL="" Q
43 ...S ORY(ORI)=ORY(ORI)_U_"- "_ORTTL
44 ..;
45 ..; Get data in case of dupes:
46 ..I ORDUP D
47 ...S ORIEN2=ORLAST ; Prev IEN for NP2 call.
48 ...;
49 ...; Reset, use previous array element, call for extended data:
50 ...S ORI=ORI-1,ORY(ORI)=$P(ORY(ORI),U)_U_$P(ORY(ORI),U,2) D NP2
51 ...;
52 ...; Then return to current user for second extended data call:
53 ...S ORIEN2=ORIEN1,ORI=ORI+1 D NP2
54 ..S ORLAST=ORIEN1,ORPREV=ORFROM ; Reassign vars for next pass.
55 ;
56 Q
57 ;
58NP2 ; Retrieve subset of data for dupes in NP1.
59 ; (Assumes certain vars already set/new'd in calling code.)
60 ;
61 ; Variables used:
62 ; ORZ = Memory array storage variable.
63 ; ORZERR = Error storage for LIST^DIC call.
64 ;
65 N ORZ,ORZERR ; Initialize variables.
66 S ORDIV="" ; Reset each time.
67 D NP4(1) ; Get Title, Service/Section.
68 ;
69 ; For multi-divisional site, get Division if determinable:
70 I ORMULTI D
71 .D LIST^DIC(200.02,","_ORIEN2_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
72 .S (ORDD,ORGOOD)=0 ; Initialize variables.
73 .I $P(ORZ("DILIST",0),U)=0 Q ; Division not listed.
74 .I $P(ORZ("DILIST",0),U)=1 D Q ; Only one, so use it.
75 ..S ORDD=$O(ORZ("DILIST",ORDD)) ; Get the node's entry.
76 ..S ORDIV=$P(ORDD,U,2) ; Get actual name value.
77 .;
78 .; More than one Division entry, so:
79 .F S ORDD=$O(ORZ("DILIST",ORDD)) Q:+ORDD=0!'($L(ORDD)) D Q:ORGOOD
80 ..;
81 ..; See if current entry being processed is "Default" (done if so):
82 ..I $P(ORZ("DILIST",ORDD,0),U,3)["Y" S ORDIV=$P(ORZ("DILIST",ORDD,0),U,2),ORGOOD=1 Q ; Division text.
83 ;
84 ; Append new pieces to array string:
85 S ORMRK=""
86 I (ORTTL="")&(ORSRV="")&(ORDIV="") Q ; Nothing to append.
87 S ORY(ORI)=ORY(ORI)_U_"- " ; At least something exists.
88 I (ORTTL'="") S ORY(ORI)=ORY(ORI)_ORTTL,ORMRK=", " ; Title.
89 I (ORSRV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORSRV,ORMRK=", " ; Service.
90 I (ORDIV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORDIV ; Division.
91 ;
92 Q
93 ;
94NP3(COSFLAG) ; Retrieve diff. data when all users are involved, using "B" x-ref.
95 ;
96 ; COSFLAG=If TRUE, called by ORWTPN.
97 ; (Assumes certain vars already set/new'd in calling code.)
98 ;
99 N ORNODE,COSQUIT
100 S COSQUIT=0 ; Flag used in section for COSFLAG.
101 ;
102 F Q:ORI'<ORMAX S ORFROM=$O(^VA(200,"B",ORFROM),ORDIR) Q:ORFROM="" D
103 .S ORIEN1=""
104 .F S ORIEN1=$O(^VA(200,"B",ORFROM,ORIEN1),ORDIR) Q:'ORIEN1 D
105 ..;
106 ..; Screen default cosigner if appropriate (ORUSER set in ORWTPN):
107 ..I COSFLAG D
108 ...S COSQUIT=0
109 ...I '$$SCRDFCS^TIULA3(ORUSER,ORIEN1) S COSFLAG=1 Q
110 ...S ORNODE=$P($G(^VA(200,ORIEN1,0)),U)
111 ...I '$L(ORNODE) S COSFLAG=1 Q
112 ..I COSQUIT Q
113 ..;
114 ..I +$G(ORALL)=0,'$$PROVIDER^XUSER(ORIEN1,1) Q ; Terminated? Skip if ALL requested
115 ..I ORDATE>0,$$GET^XUA4A72(ORIEN1,ORDATE)<1 Q ; Check date?
116 ..I $L(ORKEY),'$D(^XUSEC(ORKEY,+ORIEN1)) Q ; Check for key?
117 ..S ORI=ORI+1,ORY(ORI)=ORIEN1_"^"_$$NAMEFMT^XLFNAME(ORFROM,"F","DcMPC")
118 ..S ORDUP=0 ; Init flag, check duplication.
119 ..I ($P(ORPREV_" "," ")=$P(ORFROM_" "," ")) S ORDUP=1
120 ..;
121 ..; Append Title if not duplicated:
122 ..I 'ORDUP D
123 ...S ORIEN2=ORIEN1
124 ...D NP4(0) ; Get Title.
125 ...I ORTTL="" Q
126 ...S ORY(ORI)=ORY(ORI)_U_"- "_ORTTL
127 ..;
128 ..; Get data in case of dupes:
129 ..I ORDUP D
130 ...S ORIEN2=ORLAST ; Set to prev. IEN for NP2.
131 ...;
132 ...; Reset, use previous array element, call for extended data:
133 ...S ORI=ORI-1,ORY(ORI)=$P(ORY(ORI),U)_U_$P(ORY(ORI),U,2) D NP2
134 ...;
135 ...; Now return to current user for second extended data call:
136 ...S ORIEN2=ORIEN1,ORI=ORI+1 D NP2
137 ..S ORLAST=ORIEN1,ORPREV=ORFROM ; Reassign vars for next pass.
138 ;
139 Q
140 ;
141NP4(ORSS) ; Retrieve Title or Title and Service/Section.
142 ; (Assumes certain vars already set/new'd in calling code.)
143 ;
144 ; Passed variable ORSS: If true, get Service/Section also.
145 ;
146 S (ORTTL,ORSRV)="" ; Init each time.
147 ; DBIA# 4329:
148 S ORTTL=$P($G(^VA(200,ORIEN2,0)),U,9) ; Get Title pointer.
149 I ORTTL<1 S ORTTL="" ; Reset var if none.
150 ; DBIA# 1234:
151 I ORTTL>0 S ORTTL=$G(^DIC(3.1,ORTTL,0)) ; Actual Title value.
152 S ORSS=$G(ORSS)
153 I ORSS D ; Get Service/Section?
154 .; DBIA# 4329:
155 .S ORSRV=$P($G(^VA(200,ORIEN2,5)),U,1) ; Get S/S pointer.
156 .I ORSRV<1 S ORSRV="" ; Reset var if none.
157 .; DBIA# 4330:
158 .I ORSRV>0 S ORSRV=$P($G(^DIC(49,ORSRV,0)),U) ; Actual S/S value.
159 ;
160 Q
161 ;
162NAMECVT(Y,IEN) ; Returns text name(mixed-case) derived from IEN xref.
163 ; GRE/2002
164 ; PKS-12/20/2002 Tag not presently used.
165 ; Y=Returned value, IEN=Internal number
166 N ORNAME
167 S IEN=IEN_","
168 S ORNAME=$$GET1^DIQ(200,IEN,20.2)
169 S Y=$$NAMEFMT^XLFNAME(.ORNAME,"F","DcMPC")
170 Q
171 ;
172DEFDIV(Y) ; Return user's default division, if specified.
173 ;
174 ; Variables used:
175 ; ORDD = Default division.
176 ; ORDIV = Division holder variable.
177 ; ORGOOD = Flag for successful default division found.
178 ; ORIEN = IEN of user.
179 ; ORZ = Memory array storage variable.
180 ; ORZERR = Error storage for LIST^DIC call.
181 ; Y = Returned value.
182 ;
183 N ORDD,ORDIV,ORGOOD,ORIEN,ORZ,ORZERR
184 ;
185 S ORIEN=DUZ,ORDIV=""
186 S Y=0,(ORDD,ORGOOD)=0 ; Initialize variables.
187 ;
188 ; Get list of divisions from NEW PERSON file multiple:
189 D LIST^DIC(200.02,","_ORIEN_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
190 I $P(ORZ("DILIST",0),U)=0 Q ; No Divisions listed.
191 ;
192 ; Iterate through list:
193 F S ORDD=$O(ORZ("DILIST",ORDD)) Q:+ORDD=0!'($L(ORDD)) D Q:ORGOOD
194 .;
195 .; See if current entry being processed is "Default" (done if so):
196 .I $P(ORZ("DILIST",ORDD,0),U,3)["Y" S ORDIV=$P(ORZ("DILIST",ORDD,0),U,2),ORGOOD=1 ; Division text.
197 .;
198 I (ORDIV="") Q ; Punt if no default division.
199 I $$UP^XLFSTR(ORDIV)="SALT LAKE CITY OIFO" S Y=1
200 ;
201 Q
202 ;
203NEWLOC(Y,ORFROM,DIR) ; Return "CZ" locations from HOSPITAL LOCATION file.
204 ; C=Clinics, Z=Other, screened by $$ACTLOC^ORWU.
205 ; .Y=returned list, ORFROM=text to $O from, DIR=$O direction.
206 N I,IEN,CNT S I=0,CNT=44
207 F Q:I'<CNT S ORFROM=$O(^SC("B",ORFROM),DIR) Q:ORFROM="" D ; IA# 10040.
208 . S IEN="" F S IEN=$O(^SC("B",ORFROM,IEN),DIR) Q:'IEN D
209 . . Q:("C"'[$P($G(^SC(IEN,0)),U,3)!('$$ACTLOC^ORWU(IEN)))
210 . . S I=I+1,Y(I)=IEN_"^"_ORFROM
211 Q
212 ;
Note: See TracBrowser for help on using the repository browser.