source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSDOL1.m

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

initial load of FOIAVistA 6/30/08 version

File size: 9.2 KB
Line 
1OOPSDOL1 ;WIOFO/CAH-CA1 EXTRACT FOR DOL ;3/15/00
2 ;;2.0;ASISTS;**4,7**;Jun 03, 2002
3EN ; Entry
4 N OCC,NAME,FN,KK,D62,D123,D124,D126,WITN
5 S OOPSAR("CA")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA")))
6 S OOPSAR(0)=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,0)))
7 S OOPSAR("CA1A")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1A")))
8 S OOPSAR("CA1B")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1B")))
9 S OOPSAR("CA1C")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1C")))
10 S OOPSAR("CA1D")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1D")))
11 S OOPSAR("CA1ES")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1ES")))
12 S OOPSAR("CA1F")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1F")))
13 S OOPSAR("CA1G")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1G")))
14 S OOPSAR("CA1H")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1H")))
15 S OOPSAR("CA1I")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1I")))
16 S OOPSAR("CA1J")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1J",0)))
17 S OOPSAR("CA1K")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1K",0)))
18 S OOPSAR("CA1L")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1L")))
19 S OOPSAR("CA1M")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1M")))
20 S OOPSAR("CA1N")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1N")))
21 ; get witness data once
22 S WITN=$O(^OOPS(2260,OOPDA,"CA1W",0))
23 I $G(WITN)'="" D
24 . S OOPSAR("CA1W",0)=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1W",WITN,0)))
25 . S OOPSAR("CA1W",1)=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1W",WITN,1)))
26OP02 ; Seg OP02
27 K OPX
28 N OFF
29 S OFF=$$GET1^DIQ(2260,OOPDA,"73:1")
30 S OPX="OP02^"_$E("00",$L(OFF)+1,2)_OFF
31 S OPX=OPX_U_$P(OOPSAR("CA1M"),U,1)_U_$P(OOPSAR("CA1M"),U,2)
32 S OPX=OPX_U_$P(OOPSAR("CA1M"),U,3)_U_$$GET1^DIQ(2260,OOPDA,"179:1")
33 S OPX=OPX_U_$E($P(OOPSAR("CA1M"),U,5),1,5)_U_$P(OOPSAR("CA1F"),U,1)
34 S OPX=OPX_U_$P(OOPSAR("CA1F"),U,2)_U_$P(OOPSAR("CA1F"),U,3)
35 S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"133:1")_U_$E($P(OOPSAR("CA1F"),U,5),1,5)
36 S OPX=OPX_U_U_U_"^|"
37 D STORE^OOPSDOLX
38OP03 ; Seg OP03
39 K OPX
40 S OPX="OP03^"_$$GET1^DIQ(2260,OOPDA,60,"E")
41 S OPX=OPX_U_$P(OOPSAR("CA"),U,5)
42 S D62=$$GET1^DIQ(2260,OOPDA,"62:1"),D123=$$GET1^DIQ(2260,OOPDA,"123:1")
43 S D124=$$GET1^DIQ(2260,OOPDA,"124:1"),D126=$$GET1^DIQ(2260,OOPDA,"126:1")
44 S OPX=OPX_U_$E("000",$L(D123)+1,3)_D123
45 S OPX=OPX_U_$E("0000",$L(D124)+1,4)_D124
46 S OPX=OPX_U_$E("00",$L(D62)+1,2)_D62
47 S OPX=OPX_U_$E("00",$L(D126)+1,2)_D126
48 S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1L"),U,7))
49 S NAME=$$GET1^DIQ(2260,OOPDA,"169:.01"),FN=$P(NAME,",",2)
50 S OPX=OPX_U_$E($P(NAME,","),1,20)
51 F KK=1:0:1 Q:$E(FN,KK)'=" " S FN=$E(FN,KK+1,$L(FN))
52 S OPX=OPX_U_$E($P(FN," "),1,10)_U_$E($P(FN," ",2),1,10)
53 S OPX=OPX_U_$P(OOPSAR("CA1L"),U,4)_U_$$MKNUM^OOPSUTL2($P(OOPSAR("CA1L"),U,5))
54 S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1ES"),U,6))
55 S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1I"),U,6))
56 S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR(0),U,5),"."))_"^|"
57 D STORE^OOPSDOLX
58OP04 ; Seg OP04
59 K OPX
60 N CAT,GRD,STP,PAYP
61 S CAT=$$GET1^DIQ(2260,OOPDA,2,"I"),PAYP=$P(OOPSAR(0),U,13)
62 S GRD=$P(OOPSAR("2162A"),U,12),STP=$P(OOPSAR("2162A"),U,13)
63 I STP="N" S STP=" N" ; special case on step
64 S OPX="OP04^"_$$DC^OOPSUTL3($P(OOPSAR("CA1ES"),U,3))
65 I $P(OOPSAR("CA1F"),U,13) D
66 .S Y=$P(OOPSAR("CA1F"),U,13) D DD^%DT S Y=$P($TR(Y,":",""),"@",2)
67 .S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR("CA1F"),U,13),"."))_Y
68 I '$P(OOPSAR("CA1F"),U,13) S OPX=OPX_U
69 I $P(OOPSAR("CA1G"),U,3) D
70 .S Y=$P(OOPSAR("CA1G"),U,3) D DD^%DT S Y=$P($TR(Y,":",""),"@",2)
71 .S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR("CA1G"),U,3),"."))_Y
72 I '$P(OOPSAR("CA1G"),U,3) S OPX=OPX_U
73 I $P(OOPSAR("CA1G"),U,2) D
74 .S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1G"),U,2))
75 I '$P(OOPSAR("CA1G"),U,2) S OPX=OPX_U
76 S RPOL=$P(OOPSAR("CA1A"),U,13)
77 S VAL=$S(RPOL="COP":"RS",RPOL="L":"ZZ",1:"NU")
78 S OPX=OPX_U_VAL_U_$P(OOPSAR("CA1I"),U,7)
79 S OPX=OPX_U_$E($P(OOPSAR(0),U,13),1,2)
80 ; V2.0 - fix Grade/Step, send nill if Volunteer or Fee Basis
81 I CAT=2!(PAYP="OT") S OPX=OPX_U_""
82 E S OPX=OPX_U_$E("00",$L(GRD)+1,2)_GRD
83 I (CAT=2)!(PAYP="OT") S OPX=OPX_U_""
84 E S OPX=OPX_U_$E("00",$L(STP)+1,2)_STP
85 I $P(OOPSAR("CA1A"),U,8)=1!($P(OOPSAR("CA1A"),U,8)=4)!($P(OOPSAR("CA1A"),U,8)=5)!($P(OOPSAR("CA1A"),U,8)=7) S OPX=OPX_U_"Y"
86 E S OPX=OPX_U_"N"
87 I $P(OOPSAR("CA1A"),U,8)=2!($P(OOPSAR("CA1A"),U,8)=4)!($P(OOPSAR("CA1A"),U,8)=6)!($P(OOPSAR("CA1A"),U,8)=7) S OPX=OPX_U_"Y"
88 E S OPX=OPX_U_"N"
89 I $P(OOPSAR("CA1A"),U,8)=3!($P(OOPSAR("CA1A"),U,8)=5)!($P(OOPSAR("CA1A"),U,8)=6)!($P(OOPSAR("CA1A"),U,8)=7) S OPX=OPX_U_"Y"
90 E S OPX=OPX_U_"N"
91 S OPX=OPX_U_"Y^Y^Y^Y"
92 I $G(WITN) D
93 . S NM=$P($G(OOPSAR("CA1W",0)),U)
94 . S:$G(NM)'="" OPX=OPX_U_"Y" S:$G(NM)="" OPX=OPX_U_"N"
95 . S WS=$P($G(OOPSAR("CA1W",0)),U,6)
96 . S:$G(WS) OPX=OPX_U_"Y" S:'$G(WS) OPX=OPX_U
97 . K NM,WS
98 I '$G(WITN) S OPX=OPX_"^N^N"
99 S OPX=OPX_U_"ASISTS^C2^Y^"
100 S OPX=OPX_$$DC^OOPSUTL3($P(OOPSAR("CA1A"),U,11))
101 S OPX=OPX_U_$P(OOPSAR("CA1A"),U,9)
102 S OPX=OPX_U_$P(OOPSAR("CA1N"),U)
103 S OPX=OPX_U_$P(OOPSAR("CA1N"),U,2)
104 S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"185:1")
105 S OPX=OPX_U_$E($P(OOPSAR("CA1A"),U,14),1,5)_"^|"
106 D STORE^OOPSDOLX
107OP05 ; Seg OP05
108 ;V2.0 if Pay Plan="OT" emp is Fee Basis send "C" in PPER
109 N PPER
110 S PPER=$P(OOPSAR("CA1L"),U,2) I (PAYP="OT") S PPER="C"
111 K OPX
112 S OPX="OP05^"_$P(OOPSAR("CA1G"),U,8)_U_$P(OOPSAR("CA1H"),U)
113 S OPX=OPX_U_$P(OOPSAR("CA1H"),U,2)_U_$P(OOPSAR("CA1H"),U,3)
114 S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"154:1")_U_$E($P(OOPSAR("CA1H"),U,5),1,5)
115 I $P(OOPSAR("CA1I"),U)'="" D
116 .S OPX=OPX_U_1
117 .S NAME=$P(OOPSAR("CA1I"),U),FN=$P(NAME,",",2)
118 .F KK=1:0:1 Q:$E(FN,KK)'=" " S FN=$E(FN,KK+1,$L(FN))
119 .S OPX=OPX_U_$E($P(NAME,","),1,20)
120 .S OPX=OPX_U_$E($P(FN," "),1,10)_U_$E($P(FN," ",2),1,10)
121 .S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"182:1")
122 I $P(OOPSAR("CA1I"),U)="" S OPX=OPX_U_"3^^^^"
123 S OPX=OPX_U_$P(OOPSAR("CA1I"),U,2)_U_$P(OOPSAR("CA1I"),U,3)
124 S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"159:1")_U_$E($P(OOPSAR("CA1I"),U,5),1,5)
125 ; if the claim is for a volunteer both the pay rate and the pay period
126 ; should be blank - llh 12/29/03
127 I CAT=2 S OPX=OPX_U_U_"^|"
128 E S OPX=OPX_U_$P(OOPSAR("CA1L"),U)_U_PPER_"^|"
129 D STORE^OOPSDOLX
130OP06 ; Seg OP06
131 S DATA=$$CONV^OOPSUTL5($P(OOPSAR("CA1F"),U,11))
132 K OPX
133 S OPX="OP06"
134 F X=1:1:7 D
135 .I DATA[X D
136 ..S OPX=OPX_U_"Y"
137 ..S OPX=OPX_U_$$HM^OOPSUTL3($P(OOPSAR("CA1F"),U,9))
138 ..S OPX=OPX_U_$$HM^OOPSUTL3($P(OOPSAR("CA1F"),U,10))
139 .I DATA'[X S OPX=OPX_"^N^^"
140 ; Generate Occ Code for DOL transfer
141 S OCC=$$GET1^DIQ(2260,OOPDA,15) ; Occupation code from PAID
142 S OCC=$S(OCC<2300:"G"_OCC,(OCC>2499&(OCC<9001)):"W"_OCC,(OCC=9999):"Z"_OCC,1:"")
143 S OPX=OPX_U_OCC_U_$P(OOPSAR("CA1A"),U,12)_"^|"
144 D STORE^OOPSDOLX
145 K DATA
146OP07 ; Seg OP07
147 K OPX
148 I $L($P(OOPSAR("CA1B"),U))<133 D
149 .S OPX="OP07^1^1^"_$P(OOPSAR("CA1B"),U)_"^|"
150 .D STORE^OOPSDOLX
151 I $L($P(OOPSAR("CA1B"),U))>132 D
152 .S OPX="OP07^1^2^"_$E($P(OOPSAR("CA1B"),U),1,132)_"^|"
153 .D STORE^OOPSDOLX
154 .K OPX
155 .S OPX="OP07^2^2^"_$E($P(OOPSAR("CA1B"),U),133,200)_"^|"
156 .D STORE^OOPSDOLX
157OP08 ; Seg OP08
158 N BK36 S BK36="" K OPX
159 S OPX="OP08^"_$S($P(OOPSAR("CA1G"),U,4)="N":"NW",1:"")
160 S OPX=OPX_U_$S($P(OOPSAR("CA1G"),U,6)="Y":"WM",1:"")
161 S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1G"),U))
162 I $G(OOPSAR("CA1K"))'="",($P(OOPSAR("CA1K"),U,4)'=0) S BK36="E5"
163 I $G(OOPSAR("CA1I"))'="",($P(OOPSAR("CA1I"),U,12)'="") S BK36="E5"
164 S OPX=OPX_U_BK36_U
165 I $P(OOPSAR("CA1I"),U,8)="N" S OPX=OPX_U_"CN"
166 E S OPX=OPX_U
167 I $P(OOPSAR("CA1L"),U,3)'="" S OPX=OPX_U_97
168 E S OPX=OPX_U
169 I $G(OOPSAR("CA1W",0))'="" D
170 . S OPX=OPX_U_"Y"
171 . S NAME=$P(OOPSAR("CA1W",0),U),FN=$P(NAME,",",2)
172 . F KK=1:0:1 Q:$E(FN,KK)'=" " S FN=$E(FN,KK+1,$L(FN))
173 . S OPX=OPX_U_$E($P(NAME,","),1,20)
174 . S OPX=OPX_U_$E($P(FN," "),1,10)_U
175 . S OPX=OPX_U_$P(OOPSAR("CA1W",0),U,2)
176 . S OPX=OPX_U_$P(OOPSAR("CA1W",0),U,3)
177 . S OPX=OPX_U_$$GET1^DIQ(5,$P(OOPSAR("CA1W",0),U,4),1) ; State Code
178 . S OPX=OPX_U_$E($P(OOPSAR("CA1W",0),U,5),1,5)
179 . S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1W",0),U,6))
180 I $G(OOPSAR("CA1W",0))="" S OPX=OPX_U_"^^^^^^^^"
181 S FL174=$P(OOPSAR("CA1L"),U,6) ;FILING INSTRUCTION
182 S CATY=$S(FL174=1:"2^0",FL174=2:"2^1",FL174=3:"1^",FL174=4:"6^",1:"")
183 S OPX=OPX_U_CATY_"^|"
184 D STORE^OOPSDOLX
185OP09 ; Seg OP09
186 I $P(OOPSAR("CA1G"),U,4)="N" D
187 .K OPX
188 .S OPX="OP09^1^1^"_$P(OOPSAR("CA1G"),U,5)_"^|" D STORE^OOPSDOLX
189OP10 ; Seg OP10
190 I $P(OOPSAR("CA1G"),U,7)'="" D
191 .K OPX
192 .S OPX="OP10^1^1^"_$P(OOPSAR("CA1G"),U,7)_"^|" D STORE^OOPSDOLX
193OP11 ; Seg OP11 - Reason for Convert (Word Processing)
194 I ($G(OOPSAR("CA1K"))'="")!($P($G(OOPSAR("CA1I")),U,12)'="") D
195 .S OPFLD=165,SEG="OP11" D WP^OOPSDOLX
196OP12 ; Seg OP12 - Supervisor not agree explain (Word Processing)
197 I $G(OOPSAR("CA1J"))'="" D
198 .S OPFLD=164,SEG="OP12" D WP^OOPSDOLX
199OP13 ; Seg OP13 - Nature of Injury
200 I $P(OOPSAR("CA1C"),U)'="" D
201 .K OPX
202 .S OPX="OP13^1^1^"_$P(OOPSAR("CA1C"),U)_"^|" D STORE^OOPSDOLX
203OP14 ; Seg OP14 - Supervisor Exception
204 I $P(OOPSAR("CA1L"),U,3)'="" D
205 .K OPX
206 .S OPX="OP14^1^1"
207 .S OPX=OPX_U_$P(OOPSAR("CA1L"),U,3)_"^|" D STORE^OOPSDOLX
208OP20 ; Seg OP20
209 K OPX
210 I $P(OOPSAR("2162B"),U,4)'="" D
211 .S OPX="OP20^"_"P"_U_$$GET1^DIQ(2260,OOPDA,"30:1")_"^|" D STORE^OOPSDOLX
212 .Q
213OP21 ; Seg OP21 Defined for future use
214OP22 ; Seg OP22 Defined for future use
215OP23 ; Seg OP23 - Statement of Witness (Not yet used)
216 I $G(OOPSAR("CA1W",1))'="" D
217 . I $L(OOPSAR("CA1W",1))<133 D
218 .. K OPX
219 .. S OPX="OP23^1^1^"_OOPSAR("CA1W",1)_"^|"
220 .. D STORE^OOPSDOLX
221 . I $L(OOPSAR("CA1W",1))>132 D
222 .. K OPX
223 .. S OPX="OP23^1^2^"_$E(OOPSAR("CA1W",1),1,132)_"^|"
224 .. D STORE^OOPSDOLX
225 .. K OPX
226 .. S OPX="OP23^2^2^"_$E(DATA,133,264)_"^|"
227 .. D STORE^OOPSDOLX
228 ;
229EXIT ; End of routine
230 K WITN
231 Q
Note: See TracBrowser for help on using the repository browser.