source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSWCE.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1OOPSWCE ;WIOFO/LLH-Workers Comp Edit routine ;3/23/00
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4EN1(CALLER) ; Main Entry Point
5 N CA,CASIGN,DIC,DONE,FORM,IEN,OOPS,OUT,SIGN,SSN,SUP,X,WOK,WCPDO
6 S (DONE,OUT,IEN)=0
7 S WOK=1 ; to set cross reference
8 Q:DUZ<1
9 Q:$G(^VA(200,DUZ,1))=""
10 ; Select a Case
11 S DIC="^OOPS(2260,"
12 S DIC("S")="I $$WC^OOPSWCE(Y)"
13 S DIC(0)="AEMNZ",DIC("A")=" Select Case: "
14 D ^DIC
15 Q:Y<1
16 Q:$D(DTOUT)!($D(DUOUT))
17 S IEN=$P(Y,U)
18 D ^OOPSDIS ; Display header info
19 S (FORM,CA)=$$GET1^DIQ(2260,IEN,52,"I")
20 S FORM=$S(FORM=1:"CA1",FORM=2:"CA2",1:"")
21 S CASIGN=$P($$EDSTA^OOPSUTL1(IEN,"S"),U,CA) ; Super signed CA form
22 D FORMS ; Process correct form
23 I OUT=2 G EXIT
24 ; If controled fields have been edited, clear Sup fields, get re-signed
25 I $D(OOPS) S DONE=$$CHGES(DONE) I DONE D CLRFLDS,SUPFLDS D:'OUT SUPSIGN
26 I OUT G EXIT
27 ; Need to have WC enter Supervisor fields
28 I 'CASIGN D SUPFLDS D:'OUT SUPSIGN
29EXIT ; Validate and allow user to sign if all required fields complete
30 N DIR,Y
31 I OUT=1 D
32 . S DIR("A")="You '^'d out, Do you want to Sign"
33 . S DIR(0)="SBM^Y:Yes;N:No"
34 . D ^DIR
35 . I Y="Y" S OUT=0
36 I 'OUT D SIGNS(FORM) ; Sign/validate Document
37 L -^OOPS(2260,IEN)
38 Q
39 ;
40FORMS ; Process Form
41 N DA,DIE,DR,FLD,I,MAX,MAX1,RET,SAL,PAY
42 N AIEN,AGN,ADD,CITY,STATE,ZIP
43 N PNAME,PADD,PCITY,PSTATE,PZIP,PTITLE,STAT,SIEN
44 ; Patch 11 - Default Chargeback code, next 6 lines
45 N OWCP,STA
46 S OWCP=""
47 S STA=$$GET1^DIQ(2260,IEN,13,"I")
48 I STA S OWCP=$$FIND1^DIC(2262.03,",1,","Q",STA)
49 I OWCP S OWCP=OWCP_",1," S OWCP=$$GET1^DIQ(2262.03,OWCP,.7)
50 I 'OWCP S OWCP=""
51 S MAX1=528 ; Max length on some WP fields
52 ; Get Default retirement from PAID - FLD = paid value
53 S FLD=28,SAL=""
54 S SAL=$$PAID^OOPSUTL1(IEN,FLD)
55 S FLD=26,RET=""
56 S RET=$$PAID^OOPSUTL1(IEN,FLD)
57 S RET=$S(RET="FULL CSRS":"CSRS",RET="FERS":"FERS",1:"OTHER")
58 S FLD=19,PAY=""
59 S PAY=$$PAID^OOPSUTL1(IEN,FLD)
60 S PAY=$S(PAY="PER ANNUM":"ANNUAL",PAY="PER HOUR":"HOURLY","PER DIEM":"DAILY","BIWEEKLY":"BI-WEEKLY",1:"")
61 ; If WCP has signed, clear signature - added 5/19/00
62 I $$GET1^DIQ(2260,IEN,67)'="" D CLRES^OOPSUTL1(IEN,"W",FORM)
63 ; If Super has not signed, prompt WC to continue or not
64 I 'CASIGN D WCSIGN Q:OUT
65 ; If Super has signed and person editing form is not Supervisor who
66 ; signed, then check for edits on certain fields. ONLY FOR CA1
67 I FORM="CA1",CASIGN,($$GET1^DIQ(2260,IEN,169,"I")'=DUZ) D WCEDIT
68 L +^OOPS(2260,IEN):2
69 E W !!?5,"Another user is editing this entry. Try later." S OUT=2 Q
70 I FORM="CA1" D CA1^OOPSWCE1 Q:OUT
71 I FORM="CA2" D CA2^OOPSWCE2 Q:OUT
72 S DIE="^OOPS(2260,",DA=IEN
73 D ^DIE
74 I ($D(Y)'=0)!($G(DIRUT)=1) S OUT=1
75 Q
76WC(IEN) ; Selection Screen
77 ; Input - IEN Internal entry number of case
78 ; Output - VIEW If 0 case not accessible, if 1 case selectable
79 ;
80 N VIEW,FORM
81 S VIEW=1
82 S FORM=$$GET1^DIQ(2260,IEN,52,"I")
83 I '$P($$EDSTA^OOPSUTL1(IEN,"E"),U,FORM) S VIEW=0 ;Employee not signed
84 I $$GET1^DIQ(2260,IEN,66)'="" S VIEW=0 ;Case sent to DOL
85 I $$GET1^DIQ(2260,IEN,51,"I")'=0 S VIEW=0 ;Case is not open
86 I '$$ISEMP^OOPSUTL4(IEN) S VIEW=0 ;not employee
87 Q VIEW
88WCEDIT ; check for edits by WC
89 ; Get data from fields 146, 147, 148, 149, 163, 164, 165.
90 N DA,DIC,DIQ,DR,%X,%Y
91 K OOPS
92 S DIC=2260,DR="146;147;148;149;163",DA=IEN,DIQ="OOPS",DIQ(0)="I"
93 D EN^DIQ1
94 S %X="^OOPS(2260,IEN,""CA1J"",",%Y="OOPS(2260,IEN,""CA1J""," D %XY^%RCR
95 S %X="^OOPS(2260,IEN,""CA1K"",",%Y="OOPS(2260,IEN,""CA1K""," D %XY^%RCR
96 Q
97WCSIGN ; Prompt user to continue as Supervisor if Super has not signed form
98 N DIR,Y
99 S DIR("A")="Are you signing for the Supervisor"
100 S DIR("A",1)="The Supervisor has not signed the "_FORM_". To continue"
101 S DIR("A",2)="editing, you will need to sign as Supervisor."
102 S DIR(0)="SBM^Y:Yes;N:No"
103 D ^DIR
104 I Y'="Y" S OUT=1
105 Q
106SUPSIGN ; Sign/validate Document
107 N DIR,ES,SUPSIGN,VALID,Y
108 S VALID=0
109 D VALIDATE^OOPSUTL4(IEN,FORM,"S",.VALID)
110 I 'VALID S OUT=2 Q ; not valid, sup not signed
111 S DIR("A")="Sign as Supervisor"
112 S DIR(0)="SBM^Y:Yes;N:No"
113 D ^DIR
114 I Y'="Y" S OUT=2 ; sup 'signed, WC cant sign
115 I Y="Y" D
116 . S SUPSIGN=$$SIG^OOPSESIG(DUZ,IEN)
117 . S ES=$S(FORM="CA1":"CA1ES",FORM="CA2":"CA2ES",1:0)
118 . I $G(ES)'="" S $P(^OOPS(2260,IEN,ES),U,4,6)=SUPSIGN
119 Q
120SIGNS(FORM) ;
121 N PAYPLAN,DA,DIE,DR,VALID
122 S VALID=0,SIGN=""
123 S PAYPLAN=$$GET1^DIQ(2260,IEN,63)
124 I '$P($$EDSTA^OOPSUTL1(IEN,"S"),U,CA) D Q ; Super hasn't signed
125 . W !!,"Supervisor has not signed "_FORM
126 D VALIDATE^OOPSUTL4(IEN,FORM,"W",.VALID)
127 I 'VALID Q
128 ; V2.0 1/9/02 - fixes for Fee Basis, Non-Paid Employees
129 I $$GET1^DIQ(2260,IEN,2,"I")=6 D Q
130 .W !,"This person is not in the PAID Employee File and does not appear "
131 .W !,"eligible to submit a claim to DOL. Please check with your"
132 .W !,"Human Resources Department for assistance. Sending a paper"
133 .W !,"hardcopy may be necessary, if allowable."
134 I (PAYPLAN="OT"),'$$VALEMP^OOPSUTL6 D Q
135 .W !,"This person does not appear to be eligible for submitting a claim"
136 .W !,"to DOL, please review the RETIREMENT, GRADE, STEP, PAY"
137 .W !,"PLAN, PAY RATE and PAY RATE PER Fields. You may need to"
138 .W !,"contact your Human Resources Department or IRM for assistance."
139 N DIR,Y
140 W !
141 S DIR("A")="OK to transmit to DOL"
142 S DIR(0)="SBM^Y:Yes;N:No"
143 D ^DIR
144 I Y="Y" S SIGN=$$SIG^OOPSESIG(DUZ,IEN)
145 ; if signed, file and send bulletin
146 I $P(SIGN,U) D
147 . S DR="",DIE="^OOPS(2260,",DA=IEN
148 . S DR(1,2260,1)="67////^S X=$P(SIGN,U)"
149 . S DR(1,2260,5)="68////^S X=$P(SIGN,U,2)"
150 . S DR(1,2260,10)="69////^S X=$P(SIGN,U,3)"
151 I $P(SIGN,U) D ^DIE,WCP^OOPSMBUL(IEN,"S")
152 Q
153CLRFLDS ; Clear Supervisor Signature fields
154 N DR,DA,DIE
155 ; Clear Supervisor Signature
156 ; Added next line for ASISTS V2.0 11/09/01
157 I '$$BROKER^XWBLIB D
158 . W !!,"Worker's Comp edit of special fields occurred, Supervisor"
159 . W !,"signature fields cleared, you will need to sign as Supervisor."
160 D CLRES^OOPSUTL1(IEN,"S",FORM)
161 ; If get in this subroutine, need to set flag that Super needs to
162 ; be notified of edits even if user ^'s out
163 S DR="",DIE="^OOPS(2260,",DA=IEN
164 S DR(1,2260,35)="199////Y"
165 D ^DIE
166 Q
167SUPFLDS ; Get Supervisor signature related data for CA1 only
168 I OUT Q
169 N DR,DA,DIE,SUP
170 S DR="",DIE="^OOPS(2260,",DA=IEN
171 ; Clear Super Title and Phone # and set DR array
172 I FORM="CA1" D
173 . S SUP=$$GET1^DIQ(200,DUZ,.01)
174 . S $P(^OOPS(2260,IEN,"CA1L"),U,4,5)="^"
175 . S DR(1,2260,1)="W !!,"" Worker's Compensation Signing for Supervisor"",!"
176 . S DR(1,2260,5)="W !,"" Signature of Supervisor and Filing Instructions"""
177 . S DR(1,2260,10)="W !,"" -----------------------------------------------"""
178 . S DR(1,2260,15)="S ITEM=38 D EXCEPT^OOPSUTL2;168 EXCEPTION"
179 . S DR(1,2260,16)="I X'="""",'$$VCHAR^OOPSUTL4(X) W !,""Invalid character entered, (~,`,@,#,$,%,^,*,_,|,\,},{,[,],>, or <),"",!,""please edit."",! S Y=168"
180 . S DR(1,2260,20)="W !,"" NAME OF SUPERVISOR.: ""_SUP"
181 . S DR(1,2260,25)="172 SUPERVISOR'S TITLE.;I X="""" S Y=172"
182 . S DR(1,2260,26)="I X'="""",'$$VCHAR^OOPSUTL4(X) W !,""Invalid character entered, (~,`,@,#,$,%,^,*,_,|,\,},{,[,],>, or <),"",!,""please edit."",! S Y=172"
183 . S DR(1,2260,30)="173 OFFICE PHONE.......;I X="""" S Y=173"
184 . ; Patch 8 - added error checking on phone per DOL requirement
185 . S DR(1,2260,35)="I $TR(X,""/-*#"","""")'?10N W !?3,""Phone number must include area code and 7 digits only. Example 703-123-8789"" S Y=173"
186 D ^DIE
187 I ($D(Y)'=0)!($G(DIRUT)=1) S OUT=2
188 Q
189CHGES(DONE) ; Verify changes have been made to controlled fields
190 ; Can quit as soon as any change is discovered
191 ; Input - none
192 ; Output - DONE if 1, at least 1 field edited, else no edits (0)
193 ;
194 N I,LINE,LP
195 F I=146:1:149,163 D Q:DONE
196 . I $$GET1^DIQ(2260,IEN,I,"I")'=OOPS(2260,IEN,I,"I") S DONE=1 Q
197 I 'DONE F I="CA1J","CA1K" I $D(OOPS(2260,IEN,I)) D Q:DONE
198 . S LINE=$P(^OOPS(2260,IEN,I,0),U,4)
199 . I LINE'=$P(OOPS(2260,IEN,I,0),U,4) S DONE=1 Q
200 . F LP=1:1:LINE D Q:DONE
201 .. I ^OOPS(2260,IEN,I,LP,0)'=OOPS(2260,IEN,I,LP,0) S DONE=1 Q
202 Q DONE
Note: See TracBrowser for help on using the repository browser.