OOPSDOL1 ;WIOFO/CAH-CA1 EXTRACT FOR DOL ;3/15/00
;;2.0;ASISTS;**4,7,17**;Jun 03, 2002;Build 2
EN ; Entry
N OCC,NAME,FN,KK,D62,D123,D124,D126,WITN
S OOPSAR("CA")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA")))
S OOPSAR(0)=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,0)))
S OOPSAR("CA1A")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1A")))
S OOPSAR("CA1B")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1B")))
S OOPSAR("CA1C")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1C")))
S OOPSAR("CA1D")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1D")))
S OOPSAR("CA1ES")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1ES")))
S OOPSAR("CA1F")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1F")))
S OOPSAR("CA1G")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1G")))
S OOPSAR("CA1H")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1H")))
S OOPSAR("CA1I")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1I")))
S OOPSAR("CA1J")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1J",0)))
S OOPSAR("CA1K")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1K",0)))
S OOPSAR("CA1L")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1L")))
S OOPSAR("CA1M")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1M")))
S OOPSAR("CA1N")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1N")))
; get witness data once
S WITN=$O(^OOPS(2260,OOPDA,"CA1W",0))
I $G(WITN)'="" D
. S OOPSAR("CA1W",0)=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1W",WITN,0)))
. S OOPSAR("CA1W",1)=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA1W",WITN,1)))
OP02 ; Seg OP02
K OPX
N OFF
S OFF=$$GET1^DIQ(2260,OOPDA,"73:1")
S OPX="OP02^"_$E("00",$L(OFF)+1,2)_OFF
S OPX=OPX_U_$P(OOPSAR("CA1M"),U,1)_U_$P(OOPSAR("CA1M"),U,2)
S OPX=OPX_U_$P(OOPSAR("CA1M"),U,3)_U_$$GET1^DIQ(2260,OOPDA,"179:1")
S OPX=OPX_U_$E($P(OOPSAR("CA1M"),U,5),1,5)_U_$P(OOPSAR("CA1F"),U,1)
S OPX=OPX_U_$P(OOPSAR("CA1F"),U,2)_U_$P(OOPSAR("CA1F"),U,3)
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"133:1")_U_$E($P(OOPSAR("CA1F"),U,5),1,5)
S OPX=OPX_U_U_U_"^|"
D STORE^OOPSDOLX
OP03 ; Seg OP03
K OPX
S OPX="OP03^"_$$GET1^DIQ(2260,OOPDA,60,"E")
S OPX=OPX_U_$P(OOPSAR("CA"),U,5)
S D62=$$GET1^DIQ(2260,OOPDA,"62:1"),D123=$$GET1^DIQ(2260,OOPDA,"123:1")
S D124=$$GET1^DIQ(2260,OOPDA,"124:1"),D126=$$GET1^DIQ(2260,OOPDA,"126:1")
S OPX=OPX_U_$E("000",$L(D123)+1,3)_D123
S OPX=OPX_U_$E("0000",$L(D124)+1,4)_D124
S OPX=OPX_U_$E("00",$L(D62)+1,2)_D62
S OPX=OPX_U_$E("00",$L(D126)+1,2)_D126
S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1L"),U,7))
S NAME=$$GET1^DIQ(2260,OOPDA,"169:.01"),FN=$P(NAME,",",2)
S OPX=OPX_U_$E($P(NAME,","),1,20)
F KK=1:0:1 Q:$E(FN,KK)'=" " S FN=$E(FN,KK+1,$L(FN))
S OPX=OPX_U_$E($P(FN," "),1,10)_U_$E($P(FN," ",2),1,10)
S OPX=OPX_U_$P(OOPSAR("CA1L"),U,4)_U_$$MKNUM^OOPSUTL2($P(OOPSAR("CA1L"),U,5))
S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1ES"),U,6))
S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1I"),U,6))
S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR(0),U,5),"."))_"^|"
D STORE^OOPSDOLX
OP04 ; Seg OP04
K OPX
N CAT,GRD,STP,PAYP
S CAT=$$GET1^DIQ(2260,OOPDA,2,"I"),PAYP=$P(OOPSAR(0),U,13)
S GRD=$P(OOPSAR("2162A"),U,12),STP=$P(OOPSAR("2162A"),U,13)
I STP="N" S STP=" N" ; special case on step
S OPX="OP04^"_$$DC^OOPSUTL3($P(OOPSAR("CA1ES"),U,3))
I $P(OOPSAR("CA1F"),U,13) D
.S Y=$P(OOPSAR("CA1F"),U,13) D DD^%DT S Y=$P($TR(Y,":",""),"@",2)
.S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR("CA1F"),U,13),"."))_Y
I '$P(OOPSAR("CA1F"),U,13) S OPX=OPX_U
I $P(OOPSAR("CA1G"),U,3) D
.S Y=$P(OOPSAR("CA1G"),U,3) D DD^%DT S Y=$P($TR(Y,":",""),"@",2)
.S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR("CA1G"),U,3),"."))_Y
I '$P(OOPSAR("CA1G"),U,3) S OPX=OPX_U
I $P(OOPSAR("CA1G"),U,2) D
.S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1G"),U,2))
I '$P(OOPSAR("CA1G"),U,2) S OPX=OPX_U
S RPOL=$P(OOPSAR("CA1A"),U,13)
S VAL=$S(RPOL="COP":"RS",RPOL="L":"ZZ",1:"NU")
S OPX=OPX_U_VAL_U_$P(OOPSAR("CA1I"),U,7)
S OPX=OPX_U_$E($P(OOPSAR(0),U,13),1,2)
; V2.0 - fix Grade/Step, send nill if Volunteer or Fee Basis
I CAT=2!(PAYP="OT") S OPX=OPX_U_""
E S OPX=OPX_U_$E("00",$L(GRD)+1,2)_GRD
I (CAT=2)!(PAYP="OT") S OPX=OPX_U_""
E S OPX=OPX_U_$E("00",$L(STP)+1,2)_STP
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"
E S OPX=OPX_U_"N"
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"
E S OPX=OPX_U_"N"
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"
E S OPX=OPX_U_"N"
S OPX=OPX_U_"Y^Y^Y^Y"
I $G(WITN) D
. S NM=$P($G(OOPSAR("CA1W",0)),U)
. S:$G(NM)'="" OPX=OPX_U_"Y" S:$G(NM)="" OPX=OPX_U_"N"
. S WS=$P($G(OOPSAR("CA1W",0)),U,6)
. S:$G(WS) OPX=OPX_U_"Y" S:'$G(WS) OPX=OPX_U
. K NM,WS
I '$G(WITN) S OPX=OPX_"^N^N"
S OPX=OPX_U_"ASISTS^C2^Y^"
S OPX=OPX_$$DC^OOPSUTL3($P(OOPSAR("CA1A"),U,11))
S OPX=OPX_U_$P(OOPSAR("CA1A"),U,9)
S OPX=OPX_U_$P(OOPSAR("CA1N"),U)
S OPX=OPX_U_$P(OOPSAR("CA1N"),U,2)
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"185:1")
S OPX=OPX_U_$E($P(OOPSAR("CA1A"),U,14),1,5)_"^|"
D STORE^OOPSDOLX
OP05 ; Seg OP05
;V2.0 if Pay Plan="OT" emp is Fee Basis send "C" in PPER
N PPER
S PPER=$P(OOPSAR("CA1L"),U,2) I (PAYP="OT") S PPER="C"
K OPX
S OPX="OP05^"_$P(OOPSAR("CA1G"),U,8)_U_$P(OOPSAR("CA1H"),U)
S OPX=OPX_U_$P(OOPSAR("CA1H"),U,2)_U_$P(OOPSAR("CA1H"),U,3)
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"154:1")_U_$E($P(OOPSAR("CA1H"),U,5),1,5)
I $P(OOPSAR("CA1I"),U)'="" D
.S OPX=OPX_U_1
.S NAME=$P(OOPSAR("CA1I"),U),FN=$P(NAME,",",2)
.F KK=1:0:1 Q:$E(FN,KK)'=" " S FN=$E(FN,KK+1,$L(FN))
.S OPX=OPX_U_$E($P(NAME,","),1,20)
.S OPX=OPX_U_$E($P(FN," "),1,10)_U_$E($P(FN," ",2),1,10)
.S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"182:1")
I $P(OOPSAR("CA1I"),U)="" S OPX=OPX_U_"3^^^^"
S OPX=OPX_U_$P(OOPSAR("CA1I"),U,2)_U_$P(OOPSAR("CA1I"),U,3)
S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"159:1")_U_$E($P(OOPSAR("CA1I"),U,5),1,5)
; if the claim is for a volunteer both the pay rate and the pay period
; should be blank - llh 12/29/03
I CAT=2 S OPX=OPX_U_U_"^|"
E S OPX=OPX_U_$P(OOPSAR("CA1L"),U)_U_PPER_"^|"
D STORE^OOPSDOLX
OP06 ; Seg OP06
S DATA=$$CONV^OOPSUTL5($P(OOPSAR("CA1F"),U,11))
K OPX
S OPX="OP06"
F X=1:1:7 D
.I DATA[X D
..S OPX=OPX_U_"Y"
..S OPX=OPX_U_$$HM^OOPSUTL3($P(OOPSAR("CA1F"),U,9))
..S OPX=OPX_U_$$HM^OOPSUTL3($P(OOPSAR("CA1F"),U,10))
.I DATA'[X S OPX=OPX_"^N^^"
; Generate Occ Code for DOL transfer
S OCC=$$GET1^DIQ(2260,OOPDA,15) ; Occupation code from PAID
S OCC=$S(OCC<2300:"G"_OCC,(OCC>2499&(OCC<9001)):"W"_OCC,(OCC=9999):"Z"_OCC,1:"")
S OPX=OPX_U_OCC_U_$P(OOPSAR("CA1A"),U,12)_"^|"
D STORE^OOPSDOLX
K DATA
OP07 ; Seg OP07
K OPX
I $L($P(OOPSAR("CA1B"),U))<133 D
.S OPX="OP07^1^1^"_$P(OOPSAR("CA1B"),U)_"^|"
.D STORE^OOPSDOLX
I $L($P(OOPSAR("CA1B"),U))>132 D
.S OPX="OP07^1^2^"_$E($P(OOPSAR("CA1B"),U),1,132)_"^|"
.D STORE^OOPSDOLX
.K OPX
.S OPX="OP07^2^2^"_$E($P(OOPSAR("CA1B"),U),133,200)_"^|"
.D STORE^OOPSDOLX
OP08 ; Seg OP08
N BK36 S BK36="" K OPX
S OPX="OP08^"_$S($P(OOPSAR("CA1G"),U,4)="N":"NW",1:"")
S OPX=OPX_U_$S($P(OOPSAR("CA1G"),U,6)="Y":"WM",1:"")
S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1G"),U))
I $G(OOPSAR("CA1K"))'="",($P(OOPSAR("CA1K"),U,4)'=0) S BK36="E5"
;I $G(OOPSAR("CA1I"))'="",($P(OOPSAR("CA1I"),U,12)'="") S BK36="E5"
I $G(OOPSAR("CA1I"))'="" D
.I $P(OOPSAR("CA1I"),U,12)'="" S BK36="E5"
.I $P(OOPSAR("CA1I"),U,13)'="" S BK36="E5"
S OPX=OPX_U_BK36_U
I $P(OOPSAR("CA1I"),U,8)="N" S OPX=OPX_U_"CN"
E S OPX=OPX_U
I $P(OOPSAR("CA1L"),U,3)'="" S OPX=OPX_U_97
E S OPX=OPX_U
I $G(OOPSAR("CA1W",0))'="" D
. S OPX=OPX_U_"Y"
. S NAME=$P(OOPSAR("CA1W",0),U),FN=$P(NAME,",",2)
. F KK=1:0:1 Q:$E(FN,KK)'=" " S FN=$E(FN,KK+1,$L(FN))
. S OPX=OPX_U_$E($P(NAME,","),1,20)
. S OPX=OPX_U_$E($P(FN," "),1,10)_U
. S OPX=OPX_U_$P(OOPSAR("CA1W",0),U,2)
. S OPX=OPX_U_$P(OOPSAR("CA1W",0),U,3)
. S OPX=OPX_U_$$GET1^DIQ(5,$P(OOPSAR("CA1W",0),U,4),1) ; State Code
. S OPX=OPX_U_$E($P(OOPSAR("CA1W",0),U,5),1,5)
. S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA1W",0),U,6))
I $G(OOPSAR("CA1W",0))="" S OPX=OPX_U_"^^^^^^^^"
S FL174=$P(OOPSAR("CA1L"),U,6) ;FILING INSTRUCTION
S CATY=$S(FL174=1:"2^0",FL174=2:"2^1",FL174=3:"1^",FL174=4:"6^",1:"")
S OPX=OPX_U_CATY_"^|"
D STORE^OOPSDOLX
OP09 ; Seg OP09
I $P(OOPSAR("CA1G"),U,4)="N" D
.K OPX
.S OPX="OP09^1^1^"_$P(OOPSAR("CA1G"),U,5)_"^|" D STORE^OOPSDOLX
OP10 ; Seg OP10
I $P(OOPSAR("CA1G"),U,7)'="" D
.K OPX
.S OPX="OP10^1^1^"_$P(OOPSAR("CA1G"),U,7)_"^|" D STORE^OOPSDOLX
OP11 ; Seg OP11 - Reason for Convert (Word Processing)
I ($G(OOPSAR("CA1K"))'="")!($P($G(OOPSAR("CA1I")),U,12)'="") D
.S OPFLD=165,SEG="OP11" D WP^OOPSDOLX
OP12 ; Seg OP12 - Supervisor not agree explain (Word Processing)
I $G(OOPSAR("CA1J"))'="" D
.S OPFLD=164,SEG="OP12" D WP^OOPSDOLX
OP13 ; Seg OP13 - Nature of Injury
I $P(OOPSAR("CA1C"),U)'="" D
.K OPX
.S OPX="OP13^1^1^"_$P(OOPSAR("CA1C"),U)_"^|" D STORE^OOPSDOLX
OP14 ; Seg OP14 - Supervisor Exception
I $P(OOPSAR("CA1L"),U,3)'="" D
.K OPX
.S OPX="OP14^1^1"
.S OPX=OPX_U_$P(OOPSAR("CA1L"),U,3)_"^|" D STORE^OOPSDOLX
OP20 ; Seg OP20
K OPX
I $P(OOPSAR("2162B"),U,4)'="" D
.S OPX="OP20^"_"P"_U_$$GET1^DIQ(2260,OOPDA,"30:1")_"^|" D STORE^OOPSDOLX
.Q
OP21 ; Seg OP21 Defined for future use
OP22 ; Seg OP22 Defined for future use
OP23 ; Seg OP23 - Statement of Witness (Not yet used)
I $G(OOPSAR("CA1W",1))'="" D
. I $L(OOPSAR("CA1W",1))<133 D
.. K OPX
.. S OPX="OP23^1^1^"_OOPSAR("CA1W",1)_"^|"
.. D STORE^OOPSDOLX
. I $L(OOPSAR("CA1W",1))>132 D
.. K OPX
.. S OPX="OP23^1^2^"_$E(OOPSAR("CA1W",1),1,132)_"^|"
.. D STORE^OOPSDOLX
.. K OPX
.. S OPX="OP23^2^2^"_$E(DATA,133,264)_"^|"
.. D STORE^OOPSDOLX
;
EXIT ; End of routine
K WITN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSDOL1 9753 printed Apr 09, 2024@20:44:47 Page 2
OOPSDOL1 ;WIOFO/CAH-CA1 EXTRACT FOR DOL ;3/15/00
+1 ;;2.0;ASISTS;**4,7,17**;Jun 03, 2002;Build 2
EN ; Entry
+1 NEW OCC,NAME,FN,KK,D62,D123,D124,D126,WITN
+2 SET OOPSAR("CA")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA")))
+3 SET OOPSAR(0)=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,0)))
+4 SET OOPSAR("CA1A")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1A")))
+5 SET OOPSAR("CA1B")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1B")))
+6 SET OOPSAR("CA1C")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1C")))
+7 SET OOPSAR("CA1D")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1D")))
+8 SET OOPSAR("CA1ES")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1ES")))
+9 SET OOPSAR("CA1F")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1F")))
+10 SET OOPSAR("CA1G")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1G")))
+11 SET OOPSAR("CA1H")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1H")))
+12 SET OOPSAR("CA1I")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1I")))
+13 SET OOPSAR("CA1J")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1J",0)))
+14 SET OOPSAR("CA1K")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1K",0)))
+15 SET OOPSAR("CA1L")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1L")))
+16 SET OOPSAR("CA1M")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1M")))
+17 SET OOPSAR("CA1N")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1N")))
+18 ; get witness data once
+19 SET WITN=$ORDER(^OOPS(2260,OOPDA,"CA1W",0))
+20 IF $GET(WITN)'=""
Begin DoDot:1
+21 SET OOPSAR("CA1W",0)=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1W",WITN,0)))
+22 SET OOPSAR("CA1W",1)=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA1W",WITN,1)))
End DoDot:1
OP02 ; Seg OP02
+1 KILL OPX
+2 NEW OFF
+3 SET OFF=$$GET1^DIQ(2260,OOPDA,"73:1")
+4 SET OPX="OP02^"_$EXTRACT("00",$LENGTH(OFF)+1,2)_OFF
+5 SET OPX=OPX_U_$PIECE(OOPSAR("CA1M"),U,1)_U_$PIECE(OOPSAR("CA1M"),U,2)
+6 SET OPX=OPX_U_$PIECE(OOPSAR("CA1M"),U,3)_U_$$GET1^DIQ(2260,OOPDA,"179:1")
+7 SET OPX=OPX_U_$EXTRACT($PIECE(OOPSAR("CA1M"),U,5),1,5)_U_$PIECE(OOPSAR("CA1F"),U,1)
+8 SET OPX=OPX_U_$PIECE(OOPSAR("CA1F"),U,2)_U_$PIECE(OOPSAR("CA1F"),U,3)
+9 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"133:1")_U_$EXTRACT($PIECE(OOPSAR("CA1F"),U,5),1,5)
+10 SET OPX=OPX_U_U_U_"^|"
+11 DO STORE^OOPSDOLX
OP03 ; Seg OP03
+1 KILL OPX
+2 SET OPX="OP03^"_$$GET1^DIQ(2260,OOPDA,60,"E")
+3 SET OPX=OPX_U_$PIECE(OOPSAR("CA"),U,5)
+4 SET D62=$$GET1^DIQ(2260,OOPDA,"62:1")
SET D123=$$GET1^DIQ(2260,OOPDA,"123:1")
+5 SET D124=$$GET1^DIQ(2260,OOPDA,"124:1")
SET D126=$$GET1^DIQ(2260,OOPDA,"126:1")
+6 SET OPX=OPX_U_$EXTRACT("000",$LENGTH(D123)+1,3)_D123
+7 SET OPX=OPX_U_$EXTRACT("0000",$LENGTH(D124)+1,4)_D124
+8 SET OPX=OPX_U_$EXTRACT("00",$LENGTH(D62)+1,2)_D62
+9 SET OPX=OPX_U_$EXTRACT("00",$LENGTH(D126)+1,2)_D126
+10 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1L"),U,7))
+11 SET NAME=$$GET1^DIQ(2260,OOPDA,"169:.01")
SET FN=$PIECE(NAME,",",2)
+12 SET OPX=OPX_U_$EXTRACT($PIECE(NAME,","),1,20)
+13 FOR KK=1:0:1
if $EXTRACT(FN,KK)'=" "
QUIT
SET FN=$EXTRACT(FN,KK+1,$LENGTH(FN))
+14 SET OPX=OPX_U_$EXTRACT($PIECE(FN," "),1,10)_U_$EXTRACT($PIECE(FN," ",2),1,10)
+15 SET OPX=OPX_U_$PIECE(OOPSAR("CA1L"),U,4)_U_$$MKNUM^OOPSUTL2($PIECE(OOPSAR("CA1L"),U,5))
+16 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1ES"),U,6))
+17 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1I"),U,6))
+18 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE($PIECE(OOPSAR(0),U,5),"."))_"^|"
+19 DO STORE^OOPSDOLX
OP04 ; Seg OP04
+1 KILL OPX
+2 NEW CAT,GRD,STP,PAYP
+3 SET CAT=$$GET1^DIQ(2260,OOPDA,2,"I")
SET PAYP=$PIECE(OOPSAR(0),U,13)
+4 SET GRD=$PIECE(OOPSAR("2162A"),U,12)
SET STP=$PIECE(OOPSAR("2162A"),U,13)
+5 ; special case on step
IF STP="N"
SET STP=" N"
+6 SET OPX="OP04^"_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1ES"),U,3))
+7 IF $PIECE(OOPSAR("CA1F"),U,13)
Begin DoDot:1
+8 SET Y=$PIECE(OOPSAR("CA1F"),U,13)
DO DD^%DT
SET Y=$PIECE($TRANSLATE(Y,":",""),"@",2)
+9 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE($PIECE(OOPSAR("CA1F"),U,13),"."))_Y
End DoDot:1
+10 IF '$PIECE(OOPSAR("CA1F"),U,13)
SET OPX=OPX_U
+11 IF $PIECE(OOPSAR("CA1G"),U,3)
Begin DoDot:1
+12 SET Y=$PIECE(OOPSAR("CA1G"),U,3)
DO DD^%DT
SET Y=$PIECE($TRANSLATE(Y,":",""),"@",2)
+13 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE($PIECE(OOPSAR("CA1G"),U,3),"."))_Y
End DoDot:1
+14 IF '$PIECE(OOPSAR("CA1G"),U,3)
SET OPX=OPX_U
+15 IF $PIECE(OOPSAR("CA1G"),U,2)
Begin DoDot:1
+16 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1G"),U,2))
End DoDot:1
+17 IF '$PIECE(OOPSAR("CA1G"),U,2)
SET OPX=OPX_U
+18 SET RPOL=$PIECE(OOPSAR("CA1A"),U,13)
+19 SET VAL=$SELECT(RPOL="COP":"RS",RPOL="L":"ZZ",1:"NU")
+20 SET OPX=OPX_U_VAL_U_$PIECE(OOPSAR("CA1I"),U,7)
+21 SET OPX=OPX_U_$EXTRACT($PIECE(OOPSAR(0),U,13),1,2)
+22 ; V2.0 - fix Grade/Step, send nill if Volunteer or Fee Basis
+23 IF CAT=2!(PAYP="OT")
SET OPX=OPX_U_""
+24 IF '$TEST
SET OPX=OPX_U_$EXTRACT("00",$LENGTH(GRD)+1,2)_GRD
+25 IF (CAT=2)!(PAYP="OT")
SET OPX=OPX_U_""
+26 IF '$TEST
SET OPX=OPX_U_$EXTRACT("00",$LENGTH(STP)+1,2)_STP
+27 IF $PIECE(OOPSAR("CA1A"),U,8)=1!($PIECE(OOPSAR("CA1A"),U,8)=4)!($PIECE(OOPSAR("CA1A"),U,8)=5)!($PIECE(OOPSAR("CA1A"),U,8)=7)
SET OPX=OPX_U_"Y"
+28 IF '$TEST
SET OPX=OPX_U_"N"
+29 IF $PIECE(OOPSAR("CA1A"),U,8)=2!($PIECE(OOPSAR("CA1A"),U,8)=4)!($PIECE(OOPSAR("CA1A"),U,8)=6)!($PIECE(OOPSAR("CA1A"),U,8)=7)
SET OPX=OPX_U_"Y"
+30 IF '$TEST
SET OPX=OPX_U_"N"
+31 IF $PIECE(OOPSAR("CA1A"),U,8)=3!($PIECE(OOPSAR("CA1A"),U,8)=5)!($PIECE(OOPSAR("CA1A"),U,8)=6)!($PIECE(OOPSAR("CA1A"),U,8)=7)
SET OPX=OPX_U_"Y"
+32 IF '$TEST
SET OPX=OPX_U_"N"
+33 SET OPX=OPX_U_"Y^Y^Y^Y"
+34 IF $GET(WITN)
Begin DoDot:1
+35 SET NM=$PIECE($GET(OOPSAR("CA1W",0)),U)
+36 if $GET(NM)'=""
SET OPX=OPX_U_"Y"
if $GET(NM)=""
SET OPX=OPX_U_"N"
+37 SET WS=$PIECE($GET(OOPSAR("CA1W",0)),U,6)
+38 if $GET(WS)
SET OPX=OPX_U_"Y"
if '$GET(WS)
SET OPX=OPX_U
+39 KILL NM,WS
End DoDot:1
+40 IF '$GET(WITN)
SET OPX=OPX_"^N^N"
+41 SET OPX=OPX_U_"ASISTS^C2^Y^"
+42 SET OPX=OPX_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1A"),U,11))
+43 SET OPX=OPX_U_$PIECE(OOPSAR("CA1A"),U,9)
+44 SET OPX=OPX_U_$PIECE(OOPSAR("CA1N"),U)
+45 SET OPX=OPX_U_$PIECE(OOPSAR("CA1N"),U,2)
+46 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"185:1")
+47 SET OPX=OPX_U_$EXTRACT($PIECE(OOPSAR("CA1A"),U,14),1,5)_"^|"
+48 DO STORE^OOPSDOLX
OP05 ; Seg OP05
+1 ;V2.0 if Pay Plan="OT" emp is Fee Basis send "C" in PPER
+2 NEW PPER
+3 SET PPER=$PIECE(OOPSAR("CA1L"),U,2)
IF (PAYP="OT")
SET PPER="C"
+4 KILL OPX
+5 SET OPX="OP05^"_$PIECE(OOPSAR("CA1G"),U,8)_U_$PIECE(OOPSAR("CA1H"),U)
+6 SET OPX=OPX_U_$PIECE(OOPSAR("CA1H"),U,2)_U_$PIECE(OOPSAR("CA1H"),U,3)
+7 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"154:1")_U_$EXTRACT($PIECE(OOPSAR("CA1H"),U,5),1,5)
+8 IF $PIECE(OOPSAR("CA1I"),U)'=""
Begin DoDot:1
+9 SET OPX=OPX_U_1
+10 SET NAME=$PIECE(OOPSAR("CA1I"),U)
SET FN=$PIECE(NAME,",",2)
+11 FOR KK=1:0:1
if $EXTRACT(FN,KK)'=" "
QUIT
SET FN=$EXTRACT(FN,KK+1,$LENGTH(FN))
+12 SET OPX=OPX_U_$EXTRACT($PIECE(NAME,","),1,20)
+13 SET OPX=OPX_U_$EXTRACT($PIECE(FN," "),1,10)_U_$EXTRACT($PIECE(FN," ",2),1,10)
+14 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"182:1")
End DoDot:1
+15 IF $PIECE(OOPSAR("CA1I"),U)=""
SET OPX=OPX_U_"3^^^^"
+16 SET OPX=OPX_U_$PIECE(OOPSAR("CA1I"),U,2)_U_$PIECE(OOPSAR("CA1I"),U,3)
+17 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"159:1")_U_$EXTRACT($PIECE(OOPSAR("CA1I"),U,5),1,5)
+18 ; if the claim is for a volunteer both the pay rate and the pay period
+19 ; should be blank - llh 12/29/03
+20 IF CAT=2
SET OPX=OPX_U_U_"^|"
+21 IF '$TEST
SET OPX=OPX_U_$PIECE(OOPSAR("CA1L"),U)_U_PPER_"^|"
+22 DO STORE^OOPSDOLX
OP06 ; Seg OP06
+1 SET DATA=$$CONV^OOPSUTL5($PIECE(OOPSAR("CA1F"),U,11))
+2 KILL OPX
+3 SET OPX="OP06"
+4 FOR X=1:1:7
Begin DoDot:1
+5 IF DATA[X
Begin DoDot:2
+6 SET OPX=OPX_U_"Y"
+7 SET OPX=OPX_U_$$HM^OOPSUTL3($PIECE(OOPSAR("CA1F"),U,9))
+8 SET OPX=OPX_U_$$HM^OOPSUTL3($PIECE(OOPSAR("CA1F"),U,10))
End DoDot:2
+9 IF DATA'[X
SET OPX=OPX_"^N^^"
End DoDot:1
+10 ; Generate Occ Code for DOL transfer
+11 ; Occupation code from PAID
SET OCC=$$GET1^DIQ(2260,OOPDA,15)
+12 SET OCC=$SELECT(OCC<2300:"G"_OCC,(OCC>2499&(OCC<9001)):"W"_OCC,(OCC=9999):"Z"_OCC,1:"")
+13 SET OPX=OPX_U_OCC_U_$PIECE(OOPSAR("CA1A"),U,12)_"^|"
+14 DO STORE^OOPSDOLX
+15 KILL DATA
OP07 ; Seg OP07
+1 KILL OPX
+2 IF $LENGTH($PIECE(OOPSAR("CA1B"),U))<133
Begin DoDot:1
+3 SET OPX="OP07^1^1^"_$PIECE(OOPSAR("CA1B"),U)_"^|"
+4 DO STORE^OOPSDOLX
End DoDot:1
+5 IF $LENGTH($PIECE(OOPSAR("CA1B"),U))>132
Begin DoDot:1
+6 SET OPX="OP07^1^2^"_$EXTRACT($PIECE(OOPSAR("CA1B"),U),1,132)_"^|"
+7 DO STORE^OOPSDOLX
+8 KILL OPX
+9 SET OPX="OP07^2^2^"_$EXTRACT($PIECE(OOPSAR("CA1B"),U),133,200)_"^|"
+10 DO STORE^OOPSDOLX
End DoDot:1
OP08 ; Seg OP08
+1 NEW BK36
SET BK36=""
KILL OPX
+2 SET OPX="OP08^"_$SELECT($PIECE(OOPSAR("CA1G"),U,4)="N":"NW",1:"")
+3 SET OPX=OPX_U_$SELECT($PIECE(OOPSAR("CA1G"),U,6)="Y":"WM",1:"")
+4 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1G"),U))
+5 IF $GET(OOPSAR("CA1K"))'=""
IF ($PIECE(OOPSAR("CA1K"),U,4)'=0)
SET BK36="E5"
+6 ;I $G(OOPSAR("CA1I"))'="",($P(OOPSAR("CA1I"),U,12)'="") S BK36="E5"
+7 IF $GET(OOPSAR("CA1I"))'=""
Begin DoDot:1
+8 IF $PIECE(OOPSAR("CA1I"),U,12)'=""
SET BK36="E5"
+9 IF $PIECE(OOPSAR("CA1I"),U,13)'=""
SET BK36="E5"
End DoDot:1
+10 SET OPX=OPX_U_BK36_U
+11 IF $PIECE(OOPSAR("CA1I"),U,8)="N"
SET OPX=OPX_U_"CN"
+12 IF '$TEST
SET OPX=OPX_U
+13 IF $PIECE(OOPSAR("CA1L"),U,3)'=""
SET OPX=OPX_U_97
+14 IF '$TEST
SET OPX=OPX_U
+15 IF $GET(OOPSAR("CA1W",0))'=""
Begin DoDot:1
+16 SET OPX=OPX_U_"Y"
+17 SET NAME=$PIECE(OOPSAR("CA1W",0),U)
SET FN=$PIECE(NAME,",",2)
+18 FOR KK=1:0:1
if $EXTRACT(FN,KK)'=" "
QUIT
SET FN=$EXTRACT(FN,KK+1,$LENGTH(FN))
+19 SET OPX=OPX_U_$EXTRACT($PIECE(NAME,","),1,20)
+20 SET OPX=OPX_U_$EXTRACT($PIECE(FN," "),1,10)_U
+21 SET OPX=OPX_U_$PIECE(OOPSAR("CA1W",0),U,2)
+22 SET OPX=OPX_U_$PIECE(OOPSAR("CA1W",0),U,3)
+23 ; State Code
SET OPX=OPX_U_$$GET1^DIQ(5,$PIECE(OOPSAR("CA1W",0),U,4),1)
+24 SET OPX=OPX_U_$EXTRACT($PIECE(OOPSAR("CA1W",0),U,5),1,5)
+25 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA1W",0),U,6))
End DoDot:1
+26 IF $GET(OOPSAR("CA1W",0))=""
SET OPX=OPX_U_"^^^^^^^^"
+27 ;FILING INSTRUCTION
SET FL174=$PIECE(OOPSAR("CA1L"),U,6)
+28 SET CATY=$SELECT(FL174=1:"2^0",FL174=2:"2^1",FL174=3:"1^",FL174=4:"6^",1:"")
+29 SET OPX=OPX_U_CATY_"^|"
+30 DO STORE^OOPSDOLX
OP09 ; Seg OP09
+1 IF $PIECE(OOPSAR("CA1G"),U,4)="N"
Begin DoDot:1
+2 KILL OPX
+3 SET OPX="OP09^1^1^"_$PIECE(OOPSAR("CA1G"),U,5)_"^|"
DO STORE^OOPSDOLX
End DoDot:1
OP10 ; Seg OP10
+1 IF $PIECE(OOPSAR("CA1G"),U,7)'=""
Begin DoDot:1
+2 KILL OPX
+3 SET OPX="OP10^1^1^"_$PIECE(OOPSAR("CA1G"),U,7)_"^|"
DO STORE^OOPSDOLX
End DoDot:1
OP11 ; Seg OP11 - Reason for Convert (Word Processing)
+1 IF ($GET(OOPSAR("CA1K"))'="")!($PIECE($GET(OOPSAR("CA1I")),U,12)'="")
Begin DoDot:1
+2 SET OPFLD=165
SET SEG="OP11"
DO WP^OOPSDOLX
End DoDot:1
OP12 ; Seg OP12 - Supervisor not agree explain (Word Processing)
+1 IF $GET(OOPSAR("CA1J"))'=""
Begin DoDot:1
+2 SET OPFLD=164
SET SEG="OP12"
DO WP^OOPSDOLX
End DoDot:1
OP13 ; Seg OP13 - Nature of Injury
+1 IF $PIECE(OOPSAR("CA1C"),U)'=""
Begin DoDot:1
+2 KILL OPX
+3 SET OPX="OP13^1^1^"_$PIECE(OOPSAR("CA1C"),U)_"^|"
DO STORE^OOPSDOLX
End DoDot:1
OP14 ; Seg OP14 - Supervisor Exception
+1 IF $PIECE(OOPSAR("CA1L"),U,3)'=""
Begin DoDot:1
+2 KILL OPX
+3 SET OPX="OP14^1^1"
+4 SET OPX=OPX_U_$PIECE(OOPSAR("CA1L"),U,3)_"^|"
DO STORE^OOPSDOLX
End DoDot:1
OP20 ; Seg OP20
+1 KILL OPX
+2 IF $PIECE(OOPSAR("2162B"),U,4)'=""
Begin DoDot:1
+3 SET OPX="OP20^"_"P"_U_$$GET1^DIQ(2260,OOPDA,"30:1")_"^|"
DO STORE^OOPSDOLX
+4 QUIT
End DoDot:1
OP21 ; Seg OP21 Defined for future use
OP22 ; Seg OP22 Defined for future use
OP23 ; Seg OP23 - Statement of Witness (Not yet used)
+1 IF $GET(OOPSAR("CA1W",1))'=""
Begin DoDot:1
+2 IF $LENGTH(OOPSAR("CA1W",1))<133
Begin DoDot:2
+3 KILL OPX
+4 SET OPX="OP23^1^1^"_OOPSAR("CA1W",1)_"^|"
+5 DO STORE^OOPSDOLX
End DoDot:2
+6 IF $LENGTH(OOPSAR("CA1W",1))>132
Begin DoDot:2
+7 KILL OPX
+8 SET OPX="OP23^1^2^"_$EXTRACT(OOPSAR("CA1W",1),1,132)_"^|"
+9 DO STORE^OOPSDOLX
+10 KILL OPX
+11 SET OPX="OP23^2^2^"_$EXTRACT(DATA,133,264)_"^|"
+12 DO STORE^OOPSDOLX
End DoDot:2
End DoDot:1
+13 ;
EXIT ; End of routine
+1 KILL WITN
+2 QUIT
