source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSUTL1.m@ 1713

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1OOPSUTL1 ;HINES/WAA-Utilities Routines ;3/24/98
2 ;;2.0;ASISTS;**8**;Jun 03, 2002
3 ;;
4EMP(IEN,SSN,OPEN) ; DIC filter for Employee enter edit
5 ;This is a screening routine that will filter
6 ; out those entries that the user cannot see.
7 ; Input:
8 ; IEN is the internal entry number for the entry in 2260.
9 ; SSN is the Employee Number in file 200
10 ;=========================================
11 ; VIEW is an indicator telling if the user can enter/edit
12 ; this entry
13 ;
14 N VIEW
15 S VIEW=0
16 S OPEN=$G(OPEN,0)
17 I $$OPEN(IEN,OPEN) D ;Record
18 .I $$GET1^DIQ(2260,IEN,5,"I")=SSN D ; Is this record for this employee
19 ..N SIG,INC
20 ..S SIG=$$EDSTA^OOPSUTL1(IEN,"S")
21 ..S INC=$$GET1^DIQ(2260,IEN,52,"I")
22 ..I '$P(SIG,U,INC) S VIEW=1 ; Super has not signed
23 ..I $$GET1^DIQ(2260,IEN,67)'="" S VIEW=0 ; Patch 8, no edit if to DOL
24 .Q
25 Q VIEW
26WS ; The following 4 subroutines are added with Patch 8 - DOL project
27 ; Sets the "W" xref. A routine call is used to prevent the inadvertent
28 ; re-indexing of xref. Xref is used for determining which records
29 ; should be included in transmission of claims to DOL. When the record
30 ; is placed in a Mailman message (WC xref set) this xref is killed.
31 ; Variables
32 ; WOK = set in OOPSWCE, used to prevent inadvertent
33 ; re-indexing of ^OOPS(2260,"AW",X,IEN)
34 ; IEN = uses IEN for DA of file 2260
35 ; X = field 67 (DUZ)
36 I '$D(WOK) Q
37 I '$D(IEN) D Q
38 . S MSG("DIHELP",1)="Required Cross Reference (""AW"") was not set up, call your IRM."
39 . D MSG^DIALOG("WH","","","","MSG")
40 S ^OOPS(2260,"AW",X,IEN)=""
41 Q
42WK ; Kills the "AW" xref. See above as reason for manually setting
43 ; WOK = set in OOPSWCE, used to prevent inadvertent reindex
44 ; IEN = uses IEN for DA of file 2260
45 ; X = field 67, file 2260 = DUZ
46 N WCDUZ
47 I '$D(WOK) Q
48 I '$D(IEN) D Q
49 . S MSG("DIHELP",1)="Required Cross Reference (""AW"") was not properly destroyed, call your IRM."
50 . D MSG^DIALOG("WH","","","","MSG")
51 ; V2.0 temp fix to keep duplicate entries out of x-ref
52 S WCDUZ=""
53 F S WCDUZ=$O(^OOPS(2260,"AW",WCDUZ)) Q:WCDUZ="" D
54 . I $D(^OOPS(2260,"AW",WCDUZ,IEN)) K ^OOPS(2260,"AW",WCDUZ,IEN)
55 Q
56WCS ; Sets the "AWC" xref. A routine call is used to prevent inadvertent
57 ; re-indexing of the xref. Xref is used for determining which records
58 ; were included in Mailman messages that transmitted claims to DOL
59 ; Variables
60 ; WOK = set in OOPSWCE, used to prevent inadvertent
61 ; re-indexing of ^OOPS(2260,"AW",DUZ,IEN)
62 ; IEN = record ID file 2260
63 ; X = field 66 - Date Transmitted to DOL
64 N WCDUZ
65 I '$D(WOK) Q
66 I '$D(IEN) D Q
67 . S MSG("DIHELP",1)="Required Cross Reference (""AWC"") was not set up, call your IRM."
68 . D MSG^DIALOG("WH","","","","MSG")
69 S ^OOPS(2260,"AWC",X,IEN)=""
70 ; V2.0 temp fix to keep duplicate entries out of x-ref
71 S WCDUZ=""
72 F S WCDUZ=$O(^OOPS(2260,"AW",WCDUZ)) Q:WCDUZ="" D
73 . I $D(^OOPS(2260,"AW",WCDUZ,IEN)) K ^OOPS(2260,"AW",WCDUZ,IEN)
74 Q
75WCK ; Kills the "AWC" xref. See above as reason for manually setting
76 ; WOK = set in OOPSWCE, used to prevent inadvertent reindex
77 ; IEN = uses IEN for DA of file 2260
78 ; X = field 66 - Date Transmitted to DOL
79 I '$D(WOK) Q
80 I '$D(IEN) D Q
81 . S MSG("DIHELP",1)="Required Cross Reference (""AWC"") was not properly destroyed, call your IRM."
82 . D MSG^DIALOG("WH","","","","MSG")
83 K ^OOPS(2260,"AWC",X,IEN)
84 Q
85OPEN(IEN,OPEN) ; Determine if record is open
86 N VIEW
87 S OPEN=$G(OPEN,0)
88 S VIEW=0
89 I $G(^OOPS(2260,IEN,0))="" Q VIEW
90 I 'OPEN,'$P(^OOPS(2260,IEN,0),U,6) S VIEW=1
91 I OPEN,$P(^OOPS(2260,IEN,0),U,6)'=2 S VIEW=1
92 Q VIEW
93EDSTA(IEN,CALLER) ; Gives the status of form to allows the user to
94 ;Inputs:
95 ; IEN is the internal entry number for the entry in 2260.
96 ; CALLER is the type of user who is calling the routine.
97 ; "E" = EMPLOYEE
98 ; "S" = SUPERVISOR
99 ; "O" = SAFETY
100 ; "V" = VOLUNTEER
101 ;
102 ; ======================================
103 ;Outputs
104 ; If the Caller is Employee:
105 ; SELECT=1^1 Both FORMS have been signed
106 ; 0^0 Neither form has been signed
107 ; 1^0 CA1 has been signed
108 ; 0^1 CA2 has been signed
109 ; If caller is Supervisor:
110 ; SELECT=1^1^1 all FORMS have been signed
111 ; 0^0^0 no form has been signed
112 ; 1^0^0 CA1 has been signed
113 ; 0^1^0 CA2 has been signed
114 ; 0^0^1 2162 has been signed
115 ; If caller is Safety Officer
116 ; SELECT=1 File has been signed
117 ; 0 File has not been signed
118 ; If caller is Volunteer Supervisor
119 ; SELECT=1 File has been signed
120 ; 0 File has not been signed
121 N SELECT,CA1,CA2,ACCD
122 S SELECT=""
123 I CALLER="S" D
124 .N LINE
125 .S LINE=""
126 .F I=170,266,45 D
127 ..S LINE=LINE_$S($$GET1^DIQ(2260,IEN,I,"I")'="":1,1:0)_U
128 ..Q
129 .S SELECT=$P(LINE,U,1,3)
130 .Q
131 I CALLER="E" S SELECT=$S($$GET1^DIQ(2260,IEN,120,"I")'="":1,1:0)_U_$S($$GET1^DIQ(2260,IEN,222,"I")'="":1,1:0)
132 I CALLER="O" S SELECT=$S($$GET1^DIQ(2260,IEN,49,"I")'="":1,1:0)_U
133 Q SELECT
134 ;
135EDSEL(IEN,CALLER) ; Allow you to select the form part to edit
136 ;
137 ;
138 ; IEN is the internal entry number for the entry in 2260.
139 ; CALLER is the type of user who is calling the routine.
140 ; "E" = EMPLOYEE
141 ; "S" = SUPERVISOR
142 ; "O" = SAFETY OFFICER
143 ;
144 ;
145 N SELECT,EEFORM,CNT,Y,SEC
146 S CNT=0
147 S SELECT="",SEC="0^0",FORM=""
148 S EEFORM=$$EDSTA(IEN,CALLER)
149 I CALLER="E" S SEC=$$EDSTA^OOPSUTL1(IEN,"S")
150 W @IOF,!!,?10,"Select Forms: "
151 I CALLER="S" S CNT=CNT+1 W !,?20,CNT,") Form 2162" S FORM=FORM_"2162^"
152 I '$P(SEC,U,1) S CNT=CNT+1 W !,?20,CNT,") ",$S($P(EEFORM,U)=1:"Edit",1:"Enter")," form CA1 (Injury)" S FORM=FORM_"CA1^"
153 I '$P(SEC,U,2) S CNT=CNT+1 W !,?20,CNT,") ",$S($P(EEFORM,U,2)=1:"Edit",1:"Enter")," form CA2 (Illness)" S FORM=FORM_"CA2^"
154 I CNT=1 S Y="1,"
155 E D
156 .W !!!
157 .N DIR
158 .S DIR("A")=" Select Forms"
159 .S DIR(0)="L^1:"_CNT
160 .D ^DIR
161 I +Y F I=1:1 Q:$P(Y,",",I)<1 S SELECT=SELECT_$P(FORM,U,$P(Y,",",I))_"^"
162 Q SELECT
163CLRES(IEN,CALLER,FORM) ; Clean out electronic SIG
164 ;Input
165 ; IEN = Internal Entry Number from file 2260
166 ; CALLER is the type of user who is calling the routine.
167 ; "E" = EMPLOYEE
168 ; "S" = SUPERVISOR
169 ; "O" = SAFETY OFFICER
170 ; "W" = WORKER'S COMP OFFICIAL
171 ; FORM Is the form to clear out ES
172 ; Safety Officer = 2162
173 ; Supervisor = CA1,CA2 and 2162
174 ; Employee = CA1 and CA2, DUAL ;patch 5 added DUAL
175 ; Workers Comp = CA1 and CA2, DUAL
176 ;
177 ; DOL = 1 if call from ^OOPSUTL6 to suppress printing cleared msg.
178 ;
179 N SIG,NODE,FIELD,FLG,CALL
180 Q:FORM=""
181 S FLG=""
182 ; patch 5 llh - added D block logic and new form DUAL
183 I CALLER="W" D
184 . S SIG="WCES;1,3"
185 . I FORM="DUAL" S SIG="DUAL;10,12"
186 I CALLER="O" S SIG=$S(FORM="2162":"2162ES;4,6",1:"")
187 S:CALLER="S" SIG=$S(FORM="CA1":"CA1ES;4,6",FORM="CA2":"CA2ES;4,6",FORM="2162":"2162ES;1,3",1:"")
188 ; patch 5 llh - added logic for DUAL
189 S:CALLER="E" SIG=$S(FORM="CA1":"CA1ES;1,3",FORM="CA2":"CA2ES;1,3",FORM="DUAL":"DUAL;7,9",1:"")
190 Q:SIG=""
191 S NODE=$P(SIG,";") Q:NODE=""
192 S FIELD=$P(SIG,";",2)
193 S CALL=$S(CALLER="W":2,CALLER="O":1,CALLER="S":1,CALLER="E":2,1:"")
194 I 'CALL Q
195 I '$D(^OOPS(2260,IEN,NODE)) Q
196 I CALL=1,$P(^OOPS(2260,IEN,NODE),U,5)'="" S FLG=1
197 I CALL=2,$P(^OOPS(2260,IEN,NODE),U,2)'="" S FLG=1
198 ; patch 5 llh - added reset flag if form = DUAL
199 I FORM="DUAL" S FLG=""
200 F I=$P(FIELD,","):1:$P(FIELD,",",2) S $P(^OOPS(2260,IEN,NODE),U,I)=""
201 I FLG&('$G(DOL)) D
202 . ; Added '$$BROKER^XWBLIB to line below ASISTS V2.0 11/09/01 LLH
203 . I '$$BROKER^XWBLIB W !!,"Your ES has been cleared. You will need to resign.",!
204 . ;PATCH 11 CLEAR DATE SENT TO NDB IF SAFETY SIGNATURE REMOVED
205 . I CALLER="O" S $P(^OOPS(2260,IEN,0),U,11)=""
206 ; Security on ES - late in patch 8
207 ; clears checksums set when emp portion of claim signed by emp
208 ; patch 5 llh - added form DUAL
209 I CALLER="E"&('$G(DOL)),(FORM'="DUAL") D
210 . N RECORD
211 . S RECORD=$G(^OOPS(2260,IEN,"CA"))
212 . S $P(RECORD,U,7)="",$P(RECORD,U,9)="",^OOPS(2260,IEN,"CA")=RECORD
213 Q
214PAID(IEN,FLD) ; Get the data value from the PAID file (#450), if employee
215 ; Input - IEN internal entry number of case in file 2260
216 ; - FLD the PAID field number to retrieve
217 ; - NAME Name of Person Involved, used to get PAID IEN
218 ; - VAL Data value from the PAID #450, field #FLD
219 ; Output - DESC Description from Paid, if there
220 ;
221 N DESC,IEN450,NAME,LP
222 S DESC="",LP=0
223 S NAME=$$GET1^DIQ(2260,IEN,1)
224 D FIND^DIC(450,,"@;8","MPS",NAME,100)
225 I $G(DIERR) D CLEAN^DILF Q
226 F S LP=$O(^TMP("DILIST",$J,LP)) Q:LP="" D
227 . I $$GET1^DIQ(2260,IEN,5)=$P(^TMP("DILIST",$J,LP,0),U,2) D
228 .. S IEN450=$P(^TMP("DILIST",$J,LP,0),U)
229 .. S DESC=$$GET1^DIQ(450,IEN450,FLD)
230 Q DESC
231 ;
232PAYP(PAY) ; Map PAID Pay Plan to higher category for DOL project
233 ;
234 ; Input - PLAN This is the PAID Pay Plan Description
235 ; from file 454, not the PAID Code
236 ; Output - PPLAN Pay Plan that PAID Code maps to
237 ;
238 N PPLAN
239 S PPLAN=$S($E(PAY)="G":"GS",$E(PAY)="W":"WG",$E(PAY)="N":"WG",$E(PAY)="V":PAY,PAY="AD":PAY,$E(PAY)="E":PAY,$E(PAY)="S":PAY,1:"OT")
240 Q PPLAN
Note: See TracBrowser for help on using the repository browser.