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

OOPSDOL1 ;WIOFO/CAH-CA1 EXTRACT FOR DOL ;3/15/00
 ;;2.0;ASISTS;**4,7**;Jun 03, 2002
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"
 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