- OOPSDOL2 ;WIOFO/CAH-CA2 EXTRACT FOR DOL ;3/15/00
- ;;2.0;ASISTS;**17**;Jun 03, 2002;Build 2
- EN ; Entry
- N OCC,NAME,FN,KK,D62,D126,D226,D227
- S OOPSAR("CA")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA")))
- S OOPSAR("CA2A")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2A")))
- S OOPSAR("CA2B")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2B")))
- S OOPSAR("CA2C")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2C",0)))
- S OOPSAR("CA2D")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2D",0)))
- S OOPSAR("CA2E")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2E",0)))
- S OOPSAR("CA2ES")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2ES")))
- S OOPSAR("CA2F")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2F",0)))
- S OOPSAR("CA2G")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2G",0)))
- S OOPSAR("CA2H")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2H")))
- S OOPSAR("CA2I")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2I")))
- S OOPSAR("CA2J")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2J")))
- S OOPSAR("CA2K")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2K",0)))
- S OOPSAR("CA2L")=$$UP^OOPSUTL4($G(^OOPS(2260,OOPDA,"CA2L")))
- 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("CA2I"),U,1)_U_$P(OOPSAR("CA2I"),U,2)
- S OPX=OPX_U_$P(OOPSAR("CA2I"),U,3)_U_$$GET1^DIQ(2260,OOPDA,"240:1")
- S OPX=OPX_U_$E($P(OOPSAR("CA2I"),U,5),1,5)_U_$P(OOPSAR("CA2H"),U,1)
- S OPX=OPX_U_$P(OOPSAR("CA2H"),U,2)_U_$P(OOPSAR("CA2H"),U,3)
- S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"233:1")_U_$E($P(OOPSAR("CA2H"),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")
- S D126=$$GET1^DIQ(2260,OOPDA,"126:1")
- S D226=$$GET1^DIQ(2260,OOPDA,"226:1")
- S D227=$$GET1^DIQ(2260,OOPDA,"227:1")
- S OPX=OPX_U_$E("000",$L(D226)+1,3)_D226
- S OPX=OPX_U_$E("0000",$L(D227)+1,4)_D227
- 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("CA2J"),U,8))
- ; V2_P15 - name fix to remove spaces and dashes
- S NAME=$$NAMEFIX^OOPSDOLX($$GET1^DIQ(2260,OOPDA,"265:.01"))
- S OPX=OPX_U_$P(NAME,U,1)_U_$P(NAME,U,2)_U_$P(NAME,U,3)
- S OPX=OPX_U_$P(OOPSAR("CA2H"),U,8)_U_$$MKNUM^OOPSUTL2($P(OOPSAR("CA2H"),U,9))
- S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA2ES"),U,6))
- S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA2J"),U,6))_U_"^|"
- D STORE^OOPSDOLX
- OP04 ; Seg OP04
- K OPX
- N CAT,GRADE,STEP
- S CAT=$$GET1^DIQ(2260,OOPDA,2,"I")
- S GRADE=$P(OOPSAR("2162A"),U,12),STEP=$P(OOPSAR("2162A"),U,13)
- I STEP="N" S STEP=" N" ; special case on step = N
- S OPX="OP04^"_$$DC^OOPSUTL3($P(OOPSAR("CA2ES"),U,3))
- I $P(OOPSAR("CA2J"),U,9) D
- .S Y=$P(OOPSAR("CA2J"),U,9) D DD^%DT S Y=$P($TR(Y,":",""),"@",2)
- .S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR("CA2J"),U,9),"."))_Y
- I '$P(OOPSAR("CA2J"),U,9) S OPX=OPX_U
- I $P(OOPSAR("CA2J"),U,12) D
- .S Y=$P(OOPSAR("CA2J"),U,12) D DD^%DT S Y=$P($TR(Y,":",""),"@",2)
- .S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR("CA2J"),U,12),"."))_Y
- I '$P(OOPSAR("CA2J"),U,12) S OPX=OPX_U
- S OPX=OPX_"^^^"_$P(OOPSAR("CA2J"),U,7)
- S OPX=OPX_U_$E($P(OOPSAR(0),U,13),1,2)
- ;V2.0 1/9/02 - fix Grade/Step, send nill if Volunteer or Fee Basis
- I (CAT=2)!($$GET1^DIQ(2260,OOPDA,63)="OT") S OPX=OPX_U_""
- E S OPX=OPX_U_$E("00",$L(GRADE)+1,2)_GRADE
- I (CAT=2)!($$GET1^DIQ(2260,OOPDA,63)="OT") S OPX=OPX_U_""
- E S OPX=OPX_U_$E("00",$L(STEP)+1,2)_STEP
- I $P(OOPSAR("CA2A"),U,8)=1!($P(OOPSAR("CA2A"),U,8)=4)!($P(OOPSAR("CA2A"),U,8)=5)!($P(OOPSAR("CA2A"),U,8)=7) S OPX=OPX_U_"Y"
- E S OPX=OPX_U_"N"
- I $P(OOPSAR("CA2A"),U,8)=2!($P(OOPSAR("CA2A"),U,8)=4)!($P(OOPSAR("CA2A"),U,8)=6)!($P(OOPSAR("CA2A"),U,8)=7) S OPX=OPX_U_"Y"
- E S OPX=OPX_U_"N"
- I $P(OOPSAR("CA2A"),U,8)=3!($P(OOPSAR("CA2A"),U,8)=5)!($P(OOPSAR("CA2A"),U,8)=6)!($P(OOPSAR("CA2A"),U,8)=7) S OPX=OPX_U_"Y"
- E S OPX=OPX_U_"N"
- S OPX=OPX_U_"Y^Y^Y^Y"
- S OPX=OPX_U_"^^ASISTS^C2^Y"
- S OPX=OPX_U ;Date of this Notice
- S OPX=OPX_U_$P(OOPSAR("CA2B"),U) ;Illness Occurred Location
- S OPX=OPX_U_$P(OOPSAR("CA2B"),U,2) ;Illness Occurred Address
- S OPX=OPX_U_$P(OOPSAR("CA2B"),U,3) ;Illness Occurred City
- S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"212:1") ;Illness Occurred State
- S OPX=OPX_U_$E($P(OOPSAR("CA2B"),U,5),1,5)_"^|"
- D STORE^OOPSDOLX
- OP05 ; Seg OP05
- K OPX
- S OPX="OP05^"_$P(OOPSAR("CA2L"),U)
- ;V2_P15 - name fix to remove spaces and dashes - not needed here
- ; as name sent in 1 field, put in for consistency
- S NAME=$$NAMEFIX^OOPSDOLX($P(OOPSAR("CA2L"),U,2))
- S OPX=OPX_U_$E($P(NAME,U,1)_","_$P(NAME,U,2)_" "_$P(NAME,U,3),1,35)
- S OPX=OPX_U_$P(OOPSAR("CA2L"),U,3)_U_$P(OOPSAR("CA2L"),U,4)
- S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"262:1")_U_$E($P(OOPSAR("CA2L"),U,6),1,5)
- I $P(OOPSAR("CA2J"),U)'="" S OPX=OPX_U_1
- E S OPX=OPX_U
- ;V2_P15 - name fix to remove spaces and dashes
- S NAME=$$NAMEFIX^OOPSDOLX($P(OOPSAR("CA2J"),U))
- S OPX=OPX_U_$P(NAME,U,1)_U_$P(NAME,U,2)_U_$P(NAME,U,3)
- I $P(OOPSAR("CA2J"),U)'="" S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"270:1")
- I $P(OOPSAR("CA2J"),U,2)'="" D
- .S OPX=OPX_U_$P(OOPSAR("CA2J"),U,2)_U_$P(OOPSAR("CA2J"),U,3)
- .S OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"248:1")_U_$E($P(OOPSAR("CA2J"),U,5),1,5)
- I $P(OOPSAR("CA2J"),U,2)="" S OPX=OPX_"^^^^"
- S OPX=OPX_U_"^^|"
- D STORE^OOPSDOLX
- OP06 ; Seg OP06
- S DATA=$$CONV^OOPSUTL5($P(OOPSAR("CA2I"),U,8))
- K OPX
- S OPX="OP06"
- F X=1:1:7 D ;Loop for seven days of the week
- .I DATA[X D
- ..S OPX=OPX_U_"Y"
- ..S OPX=OPX_U_$$HM^OOPSUTL3($P(OOPSAR("CA2I"),U,6))_U_$$HM^OOPSUTL3($P(OOPSAR("CA2I"),U,7))
- .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("CA2A"),U,9)_"^|"
- D STORE^OOPSDOLX
- OP07 ; Seg OP07 RELATIONSHIP OF ILLNESS TO EMP (Word Processing)
- I $G(OOPSAR("CA2C"))'="",($P(OOPSAR("CA2C"),U,4)'=0) D
- . S OPFLD=216,SEG="OP07"
- . D WP^OOPSDOLX
- OP08 ; Seg OP08
- K OPX
- S OPX="OP08^^^^^^^"
- I $P(OOPSAR("CA2L"),U,7)'="" S OPX=OPX_97_U
- E S OPX=OPX_U
- ; patch 11 - moved Witness indicator to correct piece
- S OPX=OPX_"N^^^^^^^^^^^|"
- D STORE^OOPSDOLX
- OP13 ; Seg OP13 Nature of Disease/Illness (Word Processing)
- I $G(OOPSAR("CA2D"))'="",($P(OOPSAR("CA2D"),U,4)'=0) D
- .S OPFLD=217,SEG="OP13"
- .D WP^OOPSDOLX
- OP14 ;Seg OP14 Supervisor Exception
- S S97=$P(OOPSAR("CA2L"),U,7) ; patch 11, don't send if only a space
- I (S97'=""),(S97'=" ") D
- .K OPX
- .S OPX="OP14^1^1^"_S97_"^|" ;Supervisor Exception
- .D STORE^OOPSDOLX
- K S97
- OP15 ; Seg OP15
- K OPX
- S OPX="OP15^"_$$DC^OOPSUTL3($P(OOPSAR("CA2J"),U,11))
- S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA2B"),U,6))
- S OPX=OPX_U_$$DC^OOPSUTL3($P(OOPSAR("CA2B"),U,7))
- S OPX=OPX_U_$$DC^OOPSUTL3($P($P(OOPSAR("CA2J"),U,10),"."))
- S Y=$P(OOPSAR("CA2J"),U,10) D DD^%DT S Y=$P($TR(Y,":",""),"@",2)
- S OPX=OPX_Y
- I $G(OOPSAR("CA2C"))'="",($P(OOPSAR("CA2C"),U,4)'=0) S OPX=OPX_U_"Y"
- E S OPX=OPX_U_"N"
- I $G(OOPSAR("CA2K"))'="",($P(OOPSAR("CA2K"),U,4)'=0) S OPX=OPX_U_"Y"
- E S OPX=OPX_U_"N"
- I $G(OOPSAR("CA2E"))'="",($P(OOPSAR("CA2E"),U,4)'=0) S OPX=OPX_U_"Y"
- E S OPX=OPX_U_"N"
- I $G(OOPSAR("CA2G"))'="",($P(OOPSAR("CA2G"),U,4)'=0) S OPX=OPX_U_"Y"
- E S OPX=OPX_U_"N"
- I $G(OOPSAR("CA2F"))'="",($P(OOPSAR("CA2F"),U,4)'=0) S OPX=OPX_U_"Y^|"
- E S OPX=OPX_U_"N^|"
- D STORE^OOPSDOLX
- OP16 ; Seg OP16 Work Duty Changed (Word Processing)
- I $G(OOPSAR("CA2K"))'="",($P(OOPSAR("CA2K"),U,4)'=0) D
- .S OPFLD=257,SEG="OP16"
- .D WP^OOPSDOLX
- OP17 ; Seg OP17 Claim not Filed (Word Processing)
- I $G(OOPSAR("CA2E"))'="",($P(OOPSAR("CA2E"),U,4)'=0) D
- .S OPFLD=218,SEG="OP17"
- .D WP^OOPSDOLX
- OP18 ; Seg OP18 Medical Report Delay (Word Processing)
- I $G(OOPSAR("CA2G"))'="",($P(OOPSAR("CA2G"),U,4)'=0) D
- .S OPFLD=220,SEG="OP18"
- .D WP^OOPSDOLX
- OP19 ; Seg OP19 Employee Statement Delayed (Word Processing)
- I $G(OOPSAR("CA2F"))'="",($P(OOPSAR("CA2F"),U,4)'=0) D
- .S OPFLD=219,SEG="OP19"
- .D WP^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
- ; Only send Primary Body part at this time - per AAC 6/30/2000
- ; I $P(OOPSAR("2162B"),U,8)'="" D
- ; . N OPX
- ; . S OPX="OP20^"_"S"_U_$$GET1^DIQ(2260,OOPDA,"30.1:1")_"^|" D STORE^OOPSDOLX
- ; . Q
- OP21 ; Seg OP21 Define for future use
- OP22 ; Seg OP22 Define for future use
- EXIT ; exit the routine
- K IEN,DATA,MAX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSDOL2 8513 printed Jan 18, 2025@02:40:02 Page 2
- OOPSDOL2 ;WIOFO/CAH-CA2 EXTRACT FOR DOL ;3/15/00
- +1 ;;2.0;ASISTS;**17**;Jun 03, 2002;Build 2
- EN ; Entry
- +1 NEW OCC,NAME,FN,KK,D62,D126,D226,D227
- +2 SET OOPSAR("CA")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA")))
- +3 SET OOPSAR("CA2A")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2A")))
- +4 SET OOPSAR("CA2B")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2B")))
- +5 SET OOPSAR("CA2C")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2C",0)))
- +6 SET OOPSAR("CA2D")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2D",0)))
- +7 SET OOPSAR("CA2E")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2E",0)))
- +8 SET OOPSAR("CA2ES")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2ES")))
- +9 SET OOPSAR("CA2F")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2F",0)))
- +10 SET OOPSAR("CA2G")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2G",0)))
- +11 SET OOPSAR("CA2H")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2H")))
- +12 SET OOPSAR("CA2I")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2I")))
- +13 SET OOPSAR("CA2J")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2J")))
- +14 SET OOPSAR("CA2K")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2K",0)))
- +15 SET OOPSAR("CA2L")=$$UP^OOPSUTL4($GET(^OOPS(2260,OOPDA,"CA2L")))
- 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("CA2I"),U,1)_U_$PIECE(OOPSAR("CA2I"),U,2)
- +6 SET OPX=OPX_U_$PIECE(OOPSAR("CA2I"),U,3)_U_$$GET1^DIQ(2260,OOPDA,"240:1")
- +7 SET OPX=OPX_U_$EXTRACT($PIECE(OOPSAR("CA2I"),U,5),1,5)_U_$PIECE(OOPSAR("CA2H"),U,1)
- +8 SET OPX=OPX_U_$PIECE(OOPSAR("CA2H"),U,2)_U_$PIECE(OOPSAR("CA2H"),U,3)
- +9 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"233:1")_U_$EXTRACT($PIECE(OOPSAR("CA2H"),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")
- +5 SET D126=$$GET1^DIQ(2260,OOPDA,"126:1")
- +6 SET D226=$$GET1^DIQ(2260,OOPDA,"226:1")
- +7 SET D227=$$GET1^DIQ(2260,OOPDA,"227:1")
- +8 SET OPX=OPX_U_$EXTRACT("000",$LENGTH(D226)+1,3)_D226
- +9 SET OPX=OPX_U_$EXTRACT("0000",$LENGTH(D227)+1,4)_D227
- +10 SET OPX=OPX_U_$EXTRACT("00",$LENGTH(D62)+1,2)_D62
- +11 SET OPX=OPX_U_$EXTRACT("00",$LENGTH(D126)+1,2)_D126
- +12 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA2J"),U,8))
- +13 ; V2_P15 - name fix to remove spaces and dashes
- +14 SET NAME=$$NAMEFIX^OOPSDOLX($$GET1^DIQ(2260,OOPDA,"265:.01"))
- +15 SET OPX=OPX_U_$PIECE(NAME,U,1)_U_$PIECE(NAME,U,2)_U_$PIECE(NAME,U,3)
- +16 SET OPX=OPX_U_$PIECE(OOPSAR("CA2H"),U,8)_U_$$MKNUM^OOPSUTL2($PIECE(OOPSAR("CA2H"),U,9))
- +17 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA2ES"),U,6))
- +18 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA2J"),U,6))_U_"^|"
- +19 DO STORE^OOPSDOLX
- OP04 ; Seg OP04
- +1 KILL OPX
- +2 NEW CAT,GRADE,STEP
- +3 SET CAT=$$GET1^DIQ(2260,OOPDA,2,"I")
- +4 SET GRADE=$PIECE(OOPSAR("2162A"),U,12)
- SET STEP=$PIECE(OOPSAR("2162A"),U,13)
- +5 ; special case on step = N
- IF STEP="N"
- SET STEP=" N"
- +6 SET OPX="OP04^"_$$DC^OOPSUTL3($PIECE(OOPSAR("CA2ES"),U,3))
- +7 IF $PIECE(OOPSAR("CA2J"),U,9)
- Begin DoDot:1
- +8 SET Y=$PIECE(OOPSAR("CA2J"),U,9)
- DO DD^%DT
- SET Y=$PIECE($TRANSLATE(Y,":",""),"@",2)
- +9 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE($PIECE(OOPSAR("CA2J"),U,9),"."))_Y
- End DoDot:1
- +10 IF '$PIECE(OOPSAR("CA2J"),U,9)
- SET OPX=OPX_U
- +11 IF $PIECE(OOPSAR("CA2J"),U,12)
- Begin DoDot:1
- +12 SET Y=$PIECE(OOPSAR("CA2J"),U,12)
- DO DD^%DT
- SET Y=$PIECE($TRANSLATE(Y,":",""),"@",2)
- +13 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE($PIECE(OOPSAR("CA2J"),U,12),"."))_Y
- End DoDot:1
- +14 IF '$PIECE(OOPSAR("CA2J"),U,12)
- SET OPX=OPX_U
- +15 SET OPX=OPX_"^^^"_$PIECE(OOPSAR("CA2J"),U,7)
- +16 SET OPX=OPX_U_$EXTRACT($PIECE(OOPSAR(0),U,13),1,2)
- +17 ;V2.0 1/9/02 - fix Grade/Step, send nill if Volunteer or Fee Basis
- +18 IF (CAT=2)!($$GET1^DIQ(2260,OOPDA,63)="OT")
- SET OPX=OPX_U_""
- +19 IF '$TEST
- SET OPX=OPX_U_$EXTRACT("00",$LENGTH(GRADE)+1,2)_GRADE
- +20 IF (CAT=2)!($$GET1^DIQ(2260,OOPDA,63)="OT")
- SET OPX=OPX_U_""
- +21 IF '$TEST
- SET OPX=OPX_U_$EXTRACT("00",$LENGTH(STEP)+1,2)_STEP
- +22 IF $PIECE(OOPSAR("CA2A"),U,8)=1!($PIECE(OOPSAR("CA2A"),U,8)=4)!($PIECE(OOPSAR("CA2A"),U,8)=5)!($PIECE(OOPSAR("CA2A"),U,8)=7)
- SET OPX=OPX_U_"Y"
- +23 IF '$TEST
- SET OPX=OPX_U_"N"
- +24 IF $PIECE(OOPSAR("CA2A"),U,8)=2!($PIECE(OOPSAR("CA2A"),U,8)=4)!($PIECE(OOPSAR("CA2A"),U,8)=6)!($PIECE(OOPSAR("CA2A"),U,8)=7)
- SET OPX=OPX_U_"Y"
- +25 IF '$TEST
- SET OPX=OPX_U_"N"
- +26 IF $PIECE(OOPSAR("CA2A"),U,8)=3!($PIECE(OOPSAR("CA2A"),U,8)=5)!($PIECE(OOPSAR("CA2A"),U,8)=6)!($PIECE(OOPSAR("CA2A"),U,8)=7)
- SET OPX=OPX_U_"Y"
- +27 IF '$TEST
- SET OPX=OPX_U_"N"
- +28 SET OPX=OPX_U_"Y^Y^Y^Y"
- +29 SET OPX=OPX_U_"^^ASISTS^C2^Y"
- +30 ;Date of this Notice
- SET OPX=OPX_U
- +31 ;Illness Occurred Location
- SET OPX=OPX_U_$PIECE(OOPSAR("CA2B"),U)
- +32 ;Illness Occurred Address
- SET OPX=OPX_U_$PIECE(OOPSAR("CA2B"),U,2)
- +33 ;Illness Occurred City
- SET OPX=OPX_U_$PIECE(OOPSAR("CA2B"),U,3)
- +34 ;Illness Occurred State
- SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"212:1")
- +35 SET OPX=OPX_U_$EXTRACT($PIECE(OOPSAR("CA2B"),U,5),1,5)_"^|"
- +36 DO STORE^OOPSDOLX
- OP05 ; Seg OP05
- +1 KILL OPX
- +2 SET OPX="OP05^"_$PIECE(OOPSAR("CA2L"),U)
- +3 ;V2_P15 - name fix to remove spaces and dashes - not needed here
- +4 ; as name sent in 1 field, put in for consistency
- +5 SET NAME=$$NAMEFIX^OOPSDOLX($PIECE(OOPSAR("CA2L"),U,2))
- +6 SET OPX=OPX_U_$EXTRACT($PIECE(NAME,U,1)_","_$PIECE(NAME,U,2)_" "_$PIECE(NAME,U,3),1,35)
- +7 SET OPX=OPX_U_$PIECE(OOPSAR("CA2L"),U,3)_U_$PIECE(OOPSAR("CA2L"),U,4)
- +8 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"262:1")_U_$EXTRACT($PIECE(OOPSAR("CA2L"),U,6),1,5)
- +9 IF $PIECE(OOPSAR("CA2J"),U)'=""
- SET OPX=OPX_U_1
- +10 IF '$TEST
- SET OPX=OPX_U
- +11 ;V2_P15 - name fix to remove spaces and dashes
- +12 SET NAME=$$NAMEFIX^OOPSDOLX($PIECE(OOPSAR("CA2J"),U))
- +13 SET OPX=OPX_U_$PIECE(NAME,U,1)_U_$PIECE(NAME,U,2)_U_$PIECE(NAME,U,3)
- +14 IF $PIECE(OOPSAR("CA2J"),U)'=""
- SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"270:1")
- +15 IF $PIECE(OOPSAR("CA2J"),U,2)'=""
- Begin DoDot:1
- +16 SET OPX=OPX_U_$PIECE(OOPSAR("CA2J"),U,2)_U_$PIECE(OOPSAR("CA2J"),U,3)
- +17 SET OPX=OPX_U_$$GET1^DIQ(2260,OOPDA,"248:1")_U_$EXTRACT($PIECE(OOPSAR("CA2J"),U,5),1,5)
- End DoDot:1
- +18 IF $PIECE(OOPSAR("CA2J"),U,2)=""
- SET OPX=OPX_"^^^^"
- +19 SET OPX=OPX_U_"^^|"
- +20 DO STORE^OOPSDOLX
- OP06 ; Seg OP06
- +1 SET DATA=$$CONV^OOPSUTL5($PIECE(OOPSAR("CA2I"),U,8))
- +2 KILL OPX
- +3 SET OPX="OP06"
- +4 ;Loop for seven days of the week
- 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("CA2I"),U,6))_U_$$HM^OOPSUTL3($PIECE(OOPSAR("CA2I"),U,7))
- End DoDot:2
- +8 IF DATA'[X
- SET OPX=OPX_"^N^^"
- End DoDot:1
- +9 ; Generate Occ Code for DOL transfer
- +10 ; Occupation code from PAID
- SET OCC=$$GET1^DIQ(2260,OOPDA,15)
- +11 SET OCC=$SELECT(OCC<2300:"G"_OCC,(OCC>2499&(OCC<9001)):"W"_OCC,(OCC=9999):"Z"_OCC,1:"")
- +12 SET OPX=OPX_U_OCC_U_$PIECE(OOPSAR("CA2A"),U,9)_"^|"
- +13 DO STORE^OOPSDOLX
- OP07 ; Seg OP07 RELATIONSHIP OF ILLNESS TO EMP (Word Processing)
- +1 IF $GET(OOPSAR("CA2C"))'=""
- IF ($PIECE(OOPSAR("CA2C"),U,4)'=0)
- Begin DoDot:1
- +2 SET OPFLD=216
- SET SEG="OP07"
- +3 DO WP^OOPSDOLX
- End DoDot:1
- OP08 ; Seg OP08
- +1 KILL OPX
- +2 SET OPX="OP08^^^^^^^"
- +3 IF $PIECE(OOPSAR("CA2L"),U,7)'=""
- SET OPX=OPX_97_U
- +4 IF '$TEST
- SET OPX=OPX_U
- +5 ; patch 11 - moved Witness indicator to correct piece
- +6 SET OPX=OPX_"N^^^^^^^^^^^|"
- +7 DO STORE^OOPSDOLX
- OP13 ; Seg OP13 Nature of Disease/Illness (Word Processing)
- +1 IF $GET(OOPSAR("CA2D"))'=""
- IF ($PIECE(OOPSAR("CA2D"),U,4)'=0)
- Begin DoDot:1
- +2 SET OPFLD=217
- SET SEG="OP13"
- +3 DO WP^OOPSDOLX
- End DoDot:1
- OP14 ;Seg OP14 Supervisor Exception
- +1 ; patch 11, don't send if only a space
- SET S97=$PIECE(OOPSAR("CA2L"),U,7)
- +2 IF (S97'="")
- IF (S97'=" ")
- Begin DoDot:1
- +3 KILL OPX
- +4 ;Supervisor Exception
- SET OPX="OP14^1^1^"_S97_"^|"
- +5 DO STORE^OOPSDOLX
- End DoDot:1
- +6 KILL S97
- OP15 ; Seg OP15
- +1 KILL OPX
- +2 SET OPX="OP15^"_$$DC^OOPSUTL3($PIECE(OOPSAR("CA2J"),U,11))
- +3 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA2B"),U,6))
- +4 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE(OOPSAR("CA2B"),U,7))
- +5 SET OPX=OPX_U_$$DC^OOPSUTL3($PIECE($PIECE(OOPSAR("CA2J"),U,10),"."))
- +6 SET Y=$PIECE(OOPSAR("CA2J"),U,10)
- DO DD^%DT
- SET Y=$PIECE($TRANSLATE(Y,":",""),"@",2)
- +7 SET OPX=OPX_Y
- +8 IF $GET(OOPSAR("CA2C"))'=""
- IF ($PIECE(OOPSAR("CA2C"),U,4)'=0)
- SET OPX=OPX_U_"Y"
- +9 IF '$TEST
- SET OPX=OPX_U_"N"
- +10 IF $GET(OOPSAR("CA2K"))'=""
- IF ($PIECE(OOPSAR("CA2K"),U,4)'=0)
- SET OPX=OPX_U_"Y"
- +11 IF '$TEST
- SET OPX=OPX_U_"N"
- +12 IF $GET(OOPSAR("CA2E"))'=""
- IF ($PIECE(OOPSAR("CA2E"),U,4)'=0)
- SET OPX=OPX_U_"Y"
- +13 IF '$TEST
- SET OPX=OPX_U_"N"
- +14 IF $GET(OOPSAR("CA2G"))'=""
- IF ($PIECE(OOPSAR("CA2G"),U,4)'=0)
- SET OPX=OPX_U_"Y"
- +15 IF '$TEST
- SET OPX=OPX_U_"N"
- +16 IF $GET(OOPSAR("CA2F"))'=""
- IF ($PIECE(OOPSAR("CA2F"),U,4)'=0)
- SET OPX=OPX_U_"Y^|"
- +17 IF '$TEST
- SET OPX=OPX_U_"N^|"
- +18 DO STORE^OOPSDOLX
- OP16 ; Seg OP16 Work Duty Changed (Word Processing)
- +1 IF $GET(OOPSAR("CA2K"))'=""
- IF ($PIECE(OOPSAR("CA2K"),U,4)'=0)
- Begin DoDot:1
- +2 SET OPFLD=257
- SET SEG="OP16"
- +3 DO WP^OOPSDOLX
- End DoDot:1
- OP17 ; Seg OP17 Claim not Filed (Word Processing)
- +1 IF $GET(OOPSAR("CA2E"))'=""
- IF ($PIECE(OOPSAR("CA2E"),U,4)'=0)
- Begin DoDot:1
- +2 SET OPFLD=218
- SET SEG="OP17"
- +3 DO WP^OOPSDOLX
- End DoDot:1
- OP18 ; Seg OP18 Medical Report Delay (Word Processing)
- +1 IF $GET(OOPSAR("CA2G"))'=""
- IF ($PIECE(OOPSAR("CA2G"),U,4)'=0)
- Begin DoDot:1
- +2 SET OPFLD=220
- SET SEG="OP18"
- +3 DO WP^OOPSDOLX
- End DoDot:1
- OP19 ; Seg OP19 Employee Statement Delayed (Word Processing)
- +1 IF $GET(OOPSAR("CA2F"))'=""
- IF ($PIECE(OOPSAR("CA2F"),U,4)'=0)
- Begin DoDot:1
- +2 SET OPFLD=219
- SET SEG="OP19"
- +3 DO WP^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
- +5 ; Only send Primary Body part at this time - per AAC 6/30/2000
- +6 ; I $P(OOPSAR("2162B"),U,8)'="" D
- +7 ; . N OPX
- +8 ; . S OPX="OP20^"_"S"_U_$$GET1^DIQ(2260,OOPDA,"30.1:1")_"^|" D STORE^OOPSDOLX
- +9 ; . Q
- OP21 ; Seg OP21 Define for future use
- OP22 ; Seg OP22 Define for future use
- EXIT ; exit the routine
- +1 KILL IEN,DATA,MAX
- +2 QUIT