source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSSUPB.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1OOPSSUPB ;WIOFO/LLH-S/E Supervisor Edit for CA1 ;04/25/2000
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4 ; Note: This routine used to be part of OOPSSUP2, but had to be split
5 ; due to size limitations. This routine collects the Supervisor
6 ; portion of the CA1.
7 ;
8CA1 ; CA1 FORM
9 N ITEM,DTINJ,DT110,VWIT
10 S (AIEN,AGN,ADD,CITY,STATE,ZIP)=""
11 S (PNAME,PADD,PCITY,PSTATE,PZIP,PTITLE,STAT,SIEN)=""
12 S MAX1=528
13 S DR=""
14 W !!," Federal Employee's Notice of Traumatic Injury and Claim"
15 W !," for Continuation of Pay/Compensation (Form CA-1)"
16 W !!," Witness"
17 W !," -------"
18 ; Patch 8 - DOL project. Added collection of multiple witnesses
19 ; note: if Witness Statement entry ever allowed, max length = 528
20 S DR(2,2260.0125)=".01:5"
21 S DR(2,2260.0125,6)="6////SIGNED WITNESS STATEMENT TO FOLLOW."
22 S DR(1,2260,1)="125" ; call to witness multiple
23 S DR(1,2260,2)="S VWIT=$$WIT^OOPSUTL3"
24 S DR(1,2260,3)="I +VWIT=0!($P(VWIT,U,2)=0) S Y=125"
25 S DR(1,2260,4)="W !!,"" Supervisor's Report"""
26 S DR(1,2260,5)="W !,"" -------------------"""
27 D AGNINFO^OOPSUTL2
28 S DR(1,2260,10)="130 17. AGENCY NAME...............//^S X=AGN;I X="""" S Y=""@5"""
29 S DR(1,2260,11)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=130"
30 S DR(1,2260,15)="131 STREET ADDRESS............//^S X=ADD"
31 S DR(1,2260,16)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=131"
32 S DR(1,2260,20)="132 CITY......................//^S X=CITY"
33 S DR(1,2260,21)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=132"
34 S DR(1,2260,25)="133 STATE.....................//^S X=STATE"
35 S DR(1,2260,30)="134 ZIP CODE..................//^S X=ZIP"
36 S DR(1,2260,35)="S Y=176"
37 S DR(1,2260,40)="@5"
38 S DR(1,2260,45)="131////@"
39 S DR(1,2260,50)="132////@"
40 S DR(1,2260,55)="133////@"
41 S DR(1,2260,60)="134////@"
42 S DR(1,2260,65)="176 18. EMPLOYEE'S DUTY STATION..."
43 S DR(1,2260,66)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=176"
44 S DR(1,2260,70)="177 STREET ADDRESS............"
45 S DR(1,2260,71)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=177"
46 S DR(1,2260,75)="178 CITY......................"
47 S DR(1,2260,76)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=178"
48 S DR(1,2260,80)="179 STATE....................."
49 S DR(1,2260,85)="180 ZIP CODE.................."
50 S DR(1,2260,90)="60 19. EMPLOYEE'S RETIREMENT.....//^S X=RET;I X<3 S Y=""@6"""
51 S DR(1,2260,95)="61 OTHER RETIREMENT..........."
52 S DR(1,2260,96)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=61"
53 S DR(1,2260,97)="S Y=""@7"""
54 S DR(1,2260,98)="@6"
55 S DR(1,2260,99)="61////@"
56 S DR(1,2260,100)="@7"
57 S DR(1,2260,105)="W !,"" 20. REGULAR WORK HOURS:"""
58 S DR(1,2260,110)="138 FROM......................"
59 S DR(1,2260,115)="139 TO........................"
60 S DR(1,2260,120)="S ITEM=21 W !,"" 21. REGULAR WORK SCHEDULE.....: ""_$$GET1^DIQ(2260,D0,140,""E"")"
61 S DR(1,2260,124)="K DIR S DIR(""A"")="" "",DIR(""B"")=$$GET1^DIQ(2260,D0,140,""I"") D RWS^OOPSUTL2 S:$D(DIRUT) Y=""@2"""
62 ;
63 ; Default from 2162, require time entry but allow edit
64 S DTINJ=$$GET1^DIQ(2260,IEN,4,"E")
65 S DR(1,2260,125)="4 22. DATE/TIME INJURY OCCURRED.......//^S X=DTINJ"
66 S DR(1,2260,130)="I $P(X,""."",2)="""" W !,""Time is REQUIRED in this response."" S Y=4"
67 S DR(1,2260,135)="S DT110=$$GET1^DIQ(2260,IEN,110,""E"")"
68 S DR(1,2260,140)="175 23. DATE OF NOTICE RECEIVED...//^S X=DT110"
69 S DR(1,2260,145)="I X'="""",'$$FUT^OOPSUTL4($P(X,""."")) S Y=175"
70 S DR(1,2260,150)="142 24. DATE/TIME STOPPED WORK...."
71 S DR(1,2260,155)="I X'="""",'$$FUT^OOPSUTL4($P(X,""."")) S Y=142"
72 S DR(1,2260,160)="143 25. DATE PAY STOPPED.........."
73 S DR(1,2260,165)="I X'="""",'$$FUT^OOPSUTL4($P(X,""."")) S Y=143"
74 S DR(1,2260,170)="144 26. DATE 45 DAY PERIOD BEGAN.."
75 S DR(1,2260,175)="I X'="""",'$$FUT^OOPSUTL4($P(X,""."")) S Y=144"
76 S DR(1,2260,180)="145 27. DATE/TIME RETURNED TO WORK"
77 S DR(1,2260,185)="I X'="""",'$$FUT^OOPSUTL4($P(X,""."")) S Y=145"
78 S DR(1,2260,190)="146 28. WAS EMPLOYEE INJURED IN PERFORMANCE OF DUTY;I X=""Y"" S Y=148;"
79 S DR(1,2260,195)="147 EXPLANATION"
80 S DR(1,2260,196)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=147"
81 S DR(1,2260,200)="148 29. WAS INJURY CAUSED BY EMPLOYEE'S WILLFUL MISCONDUCT, INTOXICATION, OR INTENT TO INJURE SELF OR ANOTHER;I X=""N"" S Y=150;"
82 S DR(1,2260,205)="149 EXPLANATION"
83 S DR(1,2260,206)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=149"
84 S DR(1,2260,210)="150 30. WAS INJURY CAUSED BY 3RD PARTY;I X=""N"" S Y=""@1"""
85 S DR(1,2260,215)="W !,"" 31. NAME AND ADDRESS OF THIRD PARTY:"""
86 S DR(1,2260,220)="151 NAME OF THIRD PARTY.......;I X="""" S Y=""@1"""
87 S DR(1,2260,221)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=151"
88 S DR(1,2260,225)="152 STREET ADDRESS............"
89 S DR(1,2260,226)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=152"
90 S DR(1,2260,230)="153 CITY......................"
91 S DR(1,2260,231)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=153"
92 S DR(1,2260,235)="154 STATE....................."
93 S DR(1,2260,236)="155 ZIP CODE.................."
94 S DR(1,2260,237)="S Y=""@3"""
95 S DR(1,2260,238)="@1"
96 S DR(1,2260,239)="151////@"
97 S DR(1,2260,240)="152////@"
98 S DR(1,2260,241)="153////@"
99 S DR(1,2260,242)="154////@"
100 S DR(1,2260,243)="155////@"
101 S DR(1,2260,244)="@3"
102 S DR(1,2260,250)="W !,"" 32. NAME AND ADDRESS OF PHYSICIAN FIRST PROVIDING MEDICAL CARE:"""
103 ; Patch 7 - default physician info, if name deleted, del other fields
104 D PHINFO^OOPSUTL2
105 S DR(1,2260,255)="156 NAME OF PHYSICIAN.........//^S X=PNAME;I X="""" S Y=""@4"""
106 S DR(1,2260,256)="I X'="""",'$$NMCHK^OOPSUTL3(X) D NMERR^OOPSUTL3 K X S Y=156"
107 S DR(1,2260,260)="157 STREET ADDRESS............//^S X=PADD"
108 S DR(1,2260,261)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=157"
109 S DR(1,2260,265)="158 CITY......................//^S X=PCITY"
110 S DR(1,2260,266)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=158"
111 S DR(1,2260,270)="159 STATE.....................//^S X=PSTATE"
112 S DR(1,2260,275)="160 ZIP CODE..................//^S X=PZIP"
113 S DR(1,2260,280)="182 TITLE.....................//^S X=PTITLE"
114 S DR(1,2260,285)="S Y=161"
115 S DR(1,2260,290)="@4"
116 S DR(1,2260,295)="157////@"
117 S DR(1,2260,300)="158////@"
118 S DR(1,2260,305)="159////@"
119 S DR(1,2260,310)="160////@"
120 S DR(1,2260,315)="182////@"
121 S DR(1,2260,320)="161 33. 1ST DATE MEDICAL CARE RECEIVED"
122 S DR(1,2260,325)="I X'="""",'$$FUT^OOPSUTL4(X) S Y=161"
123 S DR(1,2260,330)="162 34. DO MEDICAL REPORTS SHOW EMPLOYEE IS DISABLED FOR WORK"
124 S DR(1,2260,335)="163 35. DOES YOUR KNOWLEDGE OF THE FACTS AGREE WITH STATEMENTS OF THE EMPLOYEE;I X=""Y"" S Y=165"
125 S DR(1,2260,340)="164 EXPLANATION~"
126 S DR(1,2260,345)="W !"
127 S DR(1,2260,350)="S MAX=$$WP^OOPSUTL4(164)"
128 S DR(1,2260,351)="I '$P(MAX,U,2) D VCHAR^OOPSUTL2 S Y=164"
129 S DR(1,2260,355)="I +MAX>MAX1 W !!,""Max length for field is "",MAX1,"" characters, you have entered "",+MAX,"". Please Edit."",! S Y=164"
130 S DR(1,2260,360)="165 36. IF THE EMPLOYING AGENCY CONTROVERTS CONTINUATION OF PAY, STATE THE REASON IN DETAIL~"
131 S DR(1,2260,365)="S MAX=$$WP^OOPSUTL4(165)"
132 S DR(1,2260,366)="I '$P(MAX,U,2) D VCHAR^OOPSUTL2 S Y=165"
133 S DR(1,2260,370)="I +MAX>MAX1 W !!,""Max length for field is "",MAX1,"" characters, you have entered "",+MAX,"". Please Edit."",! S Y=165"
134 S DR(1,2260,375)="W !!,"" 37. PAY RATE WHEN EMPLOYEE STOPPED WORK:"""
135 S DR(1,2260,380)="166 $.........................//^S X=SAL"
136 S DR(1,2260,385)="167 PER.......................//^S X=PAY"
137 S DR(1,2260,390)="W !!,"" Signature of Supervisor and Filing Instructions"""
138 S DR(1,2260,395)="W !,"" -----------------------------------------------"""
139 S DR(1,2260,400)="S ITEM=38 D EXCEPT^OOPSUTL2;168 EXCEPTION"
140 S DR(1,2260,401)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=168"
141 S DR(1,2260,405)="W !,"" NAME OF SUPERVISOR: ""_SUP"
142 S DR(1,2260,410)="172 SUPERVISOR'S TITLE."
143 S DR(1,2260,411)="I X'="""",'$$VCHAR^OOPSUTL4(X) D VCHAR^OOPSUTL2 S Y=172"
144 S DR(1,2260,415)="173 OFFICE PHONE......."
145 ; Patch 8 - add error checking for DOL requirements
146 S DR(1,2260,416)="I $TR(X,""/-*#"","""")'?10N W !?3,""Phone number must include area code and 7 digits only. Example 703-123-8789"" S Y=173"
147 S DR(1,2260,420)="174 39. FILING INSTRUCTIONS"
148 S DR(1,2260,425)="@2"
149 Q
Note: See TracBrowser for help on using the repository browser.