source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSVAL1.m@ 846

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

initial load of FOIAVistA 6/30/08 version

File size: 7.7 KB
Line 
1OOPSVAL1 ;HINES/WAA,GTD-Validate and Sign data Routines ;3/25/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4 ; Note: At EMP+18 added check to see if code being executed from
5 ; the broker. ASISTS V2.0
6 ;
7EN1(CALLER) ; Main Entry Point
8 ;INPUT:
9 ; CALLER = "E" FOR EMPLOYEE
10 ; = "S" FOR SUPERVISOR
11 ; = "O" FOR SAFETY OFFICER
12 ; = "W" FOR WORKER'S COMP
13 ;
14 N SSN,IEN,SIGN,EDIT,FORM,GRP,SUP,I,CIT,HSA,STA,ZIP
15 S IEN=0
16 Q:DUZ<1
17 Q:$G(^VA(200,DUZ,1))=""
18 I CALLER="E" S SSN=$P(^VA(200,DUZ,1),U,9) Q:$D(^OOPS(2260,"SSN",SSN))<1
19 D Q:IEN<1
20 .N DIC,X
21 .S DIC="^OOPS(2260,"
22 .I CALLER="E" S DIC("S")="I $$EMPSCR^OOPSVAL1(Y)"
23 .I CALLER="S" S DIC("S")="I $$SUPSCR^OOPSVAL1(Y)"
24 .I CALLER="O" S DIC("S")="I $$SAFSCR^OOPSVAL1(Y)"
25 .I CALLER="W" S DIC("S")="I $$WCSCR^OOPSVAL1(Y)"
26 .S DIC("S")=DIC("S")_",'$$GET1^DIQ(2260,Y,51,""I"")"
27 .S DIC(0)="AEMNZ",DIC("A")=" Select Case: "
28 .D ^DIC
29 .Q:Y<1
30 .Q:$D(DTOUT)!($D(DUOUT))
31 .S IEN=$P(Y,U)
32 .Q
33 I CALLER="O" D
34 .S FORM="2162"
35 .D FORM
36 .Q
37 I CALLER="E" D
38 .S FORM=$$GET1^DIQ(2260,IEN,52,"I")
39 .S FORM=$S(FORM=1:"CA1",FORM=2:"CA2",1:"")
40 .I FORM'="" D FORM
41 .Q
42 I CALLER="S" D
43 .N CNT,PAUSE,OUT,FORM,EDIT
44 .S (PAUSE,OUT)=0
45 .; Do block below needed so that for loop below only runs for "S"
46 .D
47 ..N INC,STAT,ESTAT
48 ..S INC=$$GET1^DIQ(2260,IEN,52,"I")
49 ..S STAT=$$EDSTA^OOPSUTL1(IEN,"S")
50 ..; added check for employee having signed CA1
51 ..S ESTAT=$$EDSTA^OOPSUTL1(IEN,"E")
52 ..; if employee signed ok to let super select if no forms signed
53 ..I $P(ESTAT,U,INC) D
54 ...I '$P(STAT,U,INC),'$P(STAT,U,3) D SELECT^OOPSSUP1 Q
55 ...S EDIT=$S('$P(STAT,U,3):2162,'$P(STAT,U,INC):$P("CA1^CA2",U,INC),1:"")
56 ..I '$P(ESTAT,U,INC) D ; Employee has not signed CA1/CA2
57 ...I '$P(STAT,U,3) S EDIT=2162 Q
58 ...S EDIT=""
59 .I EDIT="" Q
60 .F CNT=1:1 S FORM=$P(EDIT,U,CNT) Q:FORM="" D:PAUSE END Q:OUT D
61 ..D FORM S PAUSE=1
62 ..Q
63 .Q
64 I CALLER="W" D
65 .S FORM=$$GET1^DIQ(2260,IEN,52,"I")
66 .S FORM=$S(FORM=1:"CA1",FORM=2:"CA2",1:"")
67 . N DIR,Y
68 . S WOK=1
69 . W !
70 . S DIR("A")="OK to transmit to DOL"
71 . S DIR(0)="SBM^Y:Yes;N:No"
72 . D ^DIR
73 . I Y="Y",FORM'="" D FORM
74 .Q
75EXIT ;
76 K SUP,WOK ; left over from ^OOPSDIS
77 Q
78EMPSCR(IEN) ;
79 N VIEW
80 S VIEW=1
81 I '$$EMP^OOPSUTL1(IEN,SSN) S VIEW=0
82 E D
83 .N INC
84 .S INC=$$GET1^DIQ(2260,IEN,52,"I")
85 .I $P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC) S VIEW=0
86 .Q
87 Q VIEW
88SUPSCR(IEN) ;
89 N VIEW
90 S VIEW=1
91 I '$$SUPSCR^OOPSUTL2(DUZ,IEN) S VIEW=0
92 E D
93 .N INC,STAT,ESTAT,CAT
94 .S CAT=$$GET1^DIQ(2260,IEN,2,"I") ; Personnel status
95 .S INC=$$GET1^DIQ(2260,IEN,52,"I") ; Injury/Illness
96 .S STAT=$$EDSTA^OOPSUTL1(IEN,"S") ; sup signed forms
97 .S ESTAT=$$EDSTA^OOPSUTL1(IEN,"E") ; emp signed forms
98 .; Added Non-PAID employee to check, not emp, 2162 signed
99 .; Patch 5 - logic changed for new Personnel Categories
100 .I '$$ISEMP^OOPSUTL4(IEN),$P(STAT,U,3) S VIEW=0 Q
101 .; super signed 2162 and CA1/CA2
102 .I $P(STAT,U,INC),$P(STAT,U,3) S VIEW=0 Q
103 .; emp not signed CA1/CA2, super signed 2162, not signed CA1/CA2 - no
104 .I '$P(ESTAT,U,INC),$P(STAT,U,3),'$P(STAT,U,INC) S VIEW=0 Q
105 .Q
106 Q VIEW
107WCSCR(IEN) ; Patch 8 - Worker's Comp Screen
108 N INC,VIEW,ESTAT,STAT
109 S VIEW=1
110 S INC=$$GET1^DIQ(2260,IEN,52,"I")
111 S ESTAT=$$EDSTA^OOPSUTL1(IEN,"E") ;really defensive code
112 I '$P(ESTAT,U,INC) S VIEW=0 ;should never be needed
113 S STAT=$$EDSTA^OOPSUTL1(IEN,"S") ;super must have signed
114 I '$P(STAT,U,INC) S VIEW=0
115 I $$GET1^DIQ(2260,IEN,66)'="" S VIEW=0 ;Case sent to DOL
116 I $$GET1^DIQ(2260,IEN,67)'="" S VIEW=0 ;WC already signed
117 I $$GET1^DIQ(2260,IEN,51,"I")'=0 S VIEW=0 ;Case is not open
118 I '$$ISEMP^OOPSUTL4(IEN) S VIEW=0 ;not employee
119 Q VIEW
120SAFSCR(IEN) ;
121 N VIEW
122 S VIEW=1
123 I '$$SAFETY^OOPSUTL2(IEN) S VIEW=0
124 I $$EDSTA^OOPSUTL1(IEN,"O") S VIEW=0
125 Q VIEW
126END ;End of Form pause
127 N DIR
128 W !
129 S DIR(0)="E" D ^DIR
130 S:$D(DIRUT) OUT=1 Q
131 Q
132FORM ;Select Form
133 D:'$G(PAUSE,0) ^OOPSDIS
134 N OUT
135 I CALLER="E" D Q:$G(OUT)
136 . I $$GET1^DIQ(2260,IEN,71,"I")'="Y" D BOR^OOPSEMP1
137 . I $$GET1^DIQ(2260,IEN,71,"I")'="Y" D Q
138 .. W !?5,"Claim cannot be signed until the Bill of Rights Statement is understood."
139 .. D WCPBOR^OOPSMBUL(IEN)
140 .. S OUT=1
141 I '$G(OUT) D SIGN(FORM) Q:(+SIGN=0)
142 I CALLER="E",($$GET1^DIQ(2260,IEN,71,"I")="Y") D EMP
143 I CALLER="S" D SUP
144 I CALLER="O" D SAF
145 I CALLER="W" D WCP
146 Q
147SIGN(FORM) ; Sign/validate Document
148 N EMP,INC,VALID,OUT
149 S VALID=0,SIGN=""
150 S INC=$$GET1^DIQ(2260,IEN,52,"I")
151 D VALIDATE^OOPSUTL4(IEN,FORM,CALLER,.VALID)
152 I 'VALID D END Q
153 S SIGN=$$SIG^OOPSESIG(DUZ,IEN)
154 Q
155EMP ; Employee Sign off
156 N RECORD,UNIREP,X,X1,X2
157 S UNIREP=""
158 S RECORD=$G(^OOPS(2260,IEN,"CA"))
159 S X=$P($G(^VA(200,DUZ,20)),U,2)
160 S X1=DUZ
161 I FORM="CA1" D
162 . I '$$BROKER^XWBLIB S $P(^OOPS(2260,IEN,"CA1ES"),U,1,3)=SIGN
163 . S X2=$$CA1SUM^OOPSUTL6()
164 I FORM="CA2" D
165 . I '$$BROKER^XWBLIB S $P(^OOPS(2260,IEN,"CA2ES"),U,1,3)=SIGN
166 . S X2=$$CA2SUM^OOPSUTL6()
167 D EN^XUSHSHP
168 S $P(RECORD,U,9)=1
169 S $P(RECORD,U,7)=X
170 S ^OOPS(2260,IEN,"CA")=RECORD
171 D EMP^OOPSMBUL(IEN)
172 ; patch 10 - bill of rights enhancement
173 I (CALLER="E")&('$$BROKER^XWBLIB) D
174 . D CONSENT
175 . I $$GET1^DIQ(2260,IEN,72,"I")="Y" D UNION
176 . I UNIREP D CONSENT^OOPSMBUL(IEN,UNIREP)
177 Q
178SUP ;Supervisor Sign off
179 I FORM="CA1" S $P(^OOPS(2260,IEN,"CA1ES"),U,4,6)=SIGN
180 I FORM="CA2" S $P(^OOPS(2260,IEN,"CA2ES"),U,4,6)=SIGN
181 I FORM="2162" S $P(^OOPS(2260,IEN,"2162ES"),U,1,3)=SIGN D SAFETY^OOPSMBUL(IEN)
182 ; Patch 8
183 I FORM'="2162" D SUPS^OOPSMBUL(IEN),UNION^OOPSMBUL(IEN)
184 Q
185WCP ; Patch 8
186 I FORM="CA1" S $P(^OOPS(2260,IEN,"WCES"),U,1,3)=SIGN
187 I FORM="CA2" S $P(^OOPS(2260,IEN,"WCES"),U,1,3)=SIGN
188 N DA,DR,DIE
189 I $P(SIGN,U) D
190 . S DR="",DIE="^OOPS(2260,",DA=IEN
191 . S DR(1,2260,1)="67////^S X=$P(SIGN,U)"
192 . S DR(1,2260,5)="68////^S X=$P(SIGN,U,2)"
193 . S DR(1,2260,10)="69////^S X=$P(SIGN,U,3)"
194 . D ^DIE
195 D WCP^OOPSMBUL(IEN,"S")
196 Q
197SAF ; Safety Officer Sign off
198 I FORM="2162" S $P(^OOPS(2260,IEN,"2162ES"),U,4,6)=SIGN
199 Q
200CONSENT ; patch 10 - Employee consent to release information to union
201 N DIC,DIE,DA,DR,OOPS
202 S DA=IEN,DIC="^OOPS(2260,",OUT=""
203 K DIQ S DIQ(0)="IE"
204 S DIQ="OOPS",DR=".01;2;3;4;7;13;14;16;17;18;52;53;53.1" D EN^DIQ1
205 S DR=""
206 W !!,"My consent is given for the release of case number "_OOPS(2260,IEN,.01,"E")
207 W !,"information for review by local bargaining units for accident and"
208 W !,"illness tracking purposes only. Name, address, social security "
209 W !,"number, date of birth, and telephone number will not be included"
210 W !,"in the information provided to the bargaining units."
211 W !!,"With your consent, the following information will be provided"
212 W !,"to the local bargaining unit for your review."
213 W !!,"Dt/Tme Occurrence: ",OOPS(2260,IEN,4,"E")
214 W ?40," Inj/Ill: ",OOPS(2260,IEN,52,"E")
215 W !," Personnel Status: ",OOPS(2260,IEN,2,"E")
216 W ?40," Sex: ",OOPS(2260,IEN,7,"E")
217 W !," Station Number: ",OOPS(2260,IEN,13,"I")
218 W ?40," Education: ",$E(OOPS(2260,IEN,18,"E"),1,26)
219 W !," Cost Center/Org: ",OOPS(2260,IEN,14,"E")
220 W ?40," Grade/Stp: ",OOPS(2260,IEN,16,"E")_"/"_OOPS(2260,IEN,17,"E")
221 W !," Supervisor: ",$E(OOPS(2260,IEN,53,"E"),1,19)
222 W ?40,"Type Incid: ",$E(OOPS(2260,IEN,3,"E"),1,26)
223 W !," Secondary Super: ",$E(OOPS(2260,IEN,53.1,"E"),1,20),!
224 S DR(1,2260,1)="72Consent Given://^S X=""N"""
225 W !!?5,"If you give consent, you will be prompted to select the"
226 W !?5,"Union to send the bulletin to. The bulletin will be sent"
227 W !?5,"immediately after the Union has been selected.",!
228 S DIE="^OOPS(2260,"
229 D ^DIE I $D(Y) S OUT=1
230 Q
231UNION ; Get the Union Representative's DUZ
232 N DIC,DA,Y
233 S DIC="^OOPS(2263.7,",DIC(0)="AEQZ"
234 S DIC("A")="Select UNION to send bulletin to: "
235 D ^DIC
236 I +Y S UNIREP=$$GET1^DIQ(2263.7,+Y,2,"I")
237 I 'UNIREP D
238 . W !!?3,"Cannot sent a bulletin to Union, No Union Representative name was selected"
239 . W !?3,"or one is not on file. Contact your Workers' Compensation Specialist."
240 Q
Note: See TracBrowser for help on using the repository browser.