OOPSVAL1 ;HINES/WAA,GTD-Validate and Sign data Routines ;3/25/98
;;2.0;ASISTS;;Jun 03, 2002
;;
; Note: At EMP+18 added check to see if code being executed from
; the broker. ASISTS V2.0
;
EN1(CALLER) ; Main Entry Point
;INPUT:
; CALLER = "E" FOR EMPLOYEE
; = "S" FOR SUPERVISOR
; = "O" FOR SAFETY OFFICER
; = "W" FOR WORKER'S COMP
;
N SSN,IEN,SIGN,EDIT,FORM,GRP,SUP,I,CIT,HSA,STA,ZIP
S IEN=0
Q:DUZ<1
Q:$G(^VA(200,DUZ,1))=""
I CALLER="E" S SSN=$P(^VA(200,DUZ,1),U,9) Q:$D(^OOPS(2260,"SSN",SSN))<1
D Q:IEN<1
.N DIC,X
.S DIC="^OOPS(2260,"
.I CALLER="E" S DIC("S")="I $$EMPSCR^OOPSVAL1(Y)"
.I CALLER="S" S DIC("S")="I $$SUPSCR^OOPSVAL1(Y)"
.I CALLER="O" S DIC("S")="I $$SAFSCR^OOPSVAL1(Y)"
.I CALLER="W" S DIC("S")="I $$WCSCR^OOPSVAL1(Y)"
.S DIC("S")=DIC("S")_",'$$GET1^DIQ(2260,Y,51,""I"")"
.S DIC(0)="AEMNZ",DIC("A")=" Select Case: "
.D ^DIC
.Q:Y<1
.Q:$D(DTOUT)!($D(DUOUT))
.S IEN=$P(Y,U)
.Q
I CALLER="O" D
.S FORM="2162"
.D FORM
.Q
I CALLER="E" D
.S FORM=$$GET1^DIQ(2260,IEN,52,"I")
.S FORM=$S(FORM=1:"CA1",FORM=2:"CA2",1:"")
.I FORM'="" D FORM
.Q
I CALLER="S" D
.N CNT,PAUSE,OUT,FORM,EDIT
.S (PAUSE,OUT)=0
.; Do block below needed so that for loop below only runs for "S"
.D
..N INC,STAT,ESTAT
..S INC=$$GET1^DIQ(2260,IEN,52,"I")
..S STAT=$$EDSTA^OOPSUTL1(IEN,"S")
..; added check for employee having signed CA1
..S ESTAT=$$EDSTA^OOPSUTL1(IEN,"E")
..; if employee signed ok to let super select if no forms signed
..I $P(ESTAT,U,INC) D
...I '$P(STAT,U,INC),'$P(STAT,U,3) D SELECT^OOPSSUP1 Q
...S EDIT=$S('$P(STAT,U,3):2162,'$P(STAT,U,INC):$P("CA1^CA2",U,INC),1:"")
..I '$P(ESTAT,U,INC) D ; Employee has not signed CA1/CA2
...I '$P(STAT,U,3) S EDIT=2162 Q
...S EDIT=""
.I EDIT="" Q
.F CNT=1:1 S FORM=$P(EDIT,U,CNT) Q:FORM="" D:PAUSE END Q:OUT D
..D FORM S PAUSE=1
..Q
.Q
I CALLER="W" D
.S FORM=$$GET1^DIQ(2260,IEN,52,"I")
.S FORM=$S(FORM=1:"CA1",FORM=2:"CA2",1:"")
. N DIR,Y
. S WOK=1
. W !
. S DIR("A")="OK to transmit to DOL"
. S DIR(0)="SBM^Y:Yes;N:No"
. D ^DIR
. I Y="Y",FORM'="" D FORM
.Q
EXIT ;
K SUP,WOK ; left over from ^OOPSDIS
Q
EMPSCR(IEN) ;
N VIEW
S VIEW=1
I '$$EMP^OOPSUTL1(IEN,SSN) S VIEW=0
E D
.N INC
.S INC=$$GET1^DIQ(2260,IEN,52,"I")
.I $P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC) S VIEW=0
.Q
Q VIEW
SUPSCR(IEN) ;
N VIEW
S VIEW=1
I '$$SUPSCR^OOPSUTL2(DUZ,IEN) S VIEW=0
E D
.N INC,STAT,ESTAT,CAT
.S CAT=$$GET1^DIQ(2260,IEN,2,"I") ; Personnel status
.S INC=$$GET1^DIQ(2260,IEN,52,"I") ; Injury/Illness
.S STAT=$$EDSTA^OOPSUTL1(IEN,"S") ; sup signed forms
.S ESTAT=$$EDSTA^OOPSUTL1(IEN,"E") ; emp signed forms
.; Added Non-PAID employee to check, not emp, 2162 signed
.; Patch 5 - logic changed for new Personnel Categories
.I '$$ISEMP^OOPSUTL4(IEN),$P(STAT,U,3) S VIEW=0 Q
.; super signed 2162 and CA1/CA2
.I $P(STAT,U,INC),$P(STAT,U,3) S VIEW=0 Q
.; emp not signed CA1/CA2, super signed 2162, not signed CA1/CA2 - no
.I '$P(ESTAT,U,INC),$P(STAT,U,3),'$P(STAT,U,INC) S VIEW=0 Q
.Q
Q VIEW
WCSCR(IEN) ; Patch 8 - Worker's Comp Screen
N INC,VIEW,ESTAT,STAT
S VIEW=1
S INC=$$GET1^DIQ(2260,IEN,52,"I")
S ESTAT=$$EDSTA^OOPSUTL1(IEN,"E") ;really defensive code
I '$P(ESTAT,U,INC) S VIEW=0 ;should never be needed
S STAT=$$EDSTA^OOPSUTL1(IEN,"S") ;super must have signed
I '$P(STAT,U,INC) S VIEW=0
I $$GET1^DIQ(2260,IEN,66)'="" S VIEW=0 ;Case sent to DOL
I $$GET1^DIQ(2260,IEN,67)'="" S VIEW=0 ;WC already signed
I $$GET1^DIQ(2260,IEN,51,"I")'=0 S VIEW=0 ;Case is not open
I '$$ISEMP^OOPSUTL4(IEN) S VIEW=0 ;not employee
Q VIEW
SAFSCR(IEN) ;
N VIEW
S VIEW=1
I '$$SAFETY^OOPSUTL2(IEN) S VIEW=0
I $$EDSTA^OOPSUTL1(IEN,"O") S VIEW=0
Q VIEW
END ;End of Form pause
N DIR
W !
S DIR(0)="E" D ^DIR
S:$D(DIRUT) OUT=1 Q
Q
FORM ;Select Form
D:'$G(PAUSE,0) ^OOPSDIS
N OUT
I CALLER="E" D Q:$G(OUT)
. I $$GET1^DIQ(2260,IEN,71,"I")'="Y" D BOR^OOPSEMP1
. I $$GET1^DIQ(2260,IEN,71,"I")'="Y" D Q
.. W !?5,"Claim cannot be signed until the Bill of Rights Statement is understood."
.. D WCPBOR^OOPSMBUL(IEN)
.. S OUT=1
I '$G(OUT) D SIGN(FORM) Q:(+SIGN=0)
I CALLER="E",($$GET1^DIQ(2260,IEN,71,"I")="Y") D EMP
I CALLER="S" D SUP
I CALLER="O" D SAF
I CALLER="W" D WCP
Q
SIGN(FORM) ; Sign/validate Document
N EMP,INC,VALID,OUT
S VALID=0,SIGN=""
S INC=$$GET1^DIQ(2260,IEN,52,"I")
D VALIDATE^OOPSUTL4(IEN,FORM,CALLER,.VALID)
I 'VALID D END Q
S SIGN=$$SIG^OOPSESIG(DUZ,IEN)
Q
EMP ; Employee Sign off
N RECORD,UNIREP,X,X1,X2
S UNIREP=""
S RECORD=$G(^OOPS(2260,IEN,"CA"))
S X=$P($G(^VA(200,DUZ,20)),U,2)
S X1=DUZ
I FORM="CA1" D
. I '$$BROKER^XWBLIB S $P(^OOPS(2260,IEN,"CA1ES"),U,1,3)=SIGN
. S X2=$$CA1SUM^OOPSUTL6()
I FORM="CA2" D
. I '$$BROKER^XWBLIB S $P(^OOPS(2260,IEN,"CA2ES"),U,1,3)=SIGN
. S X2=$$CA2SUM^OOPSUTL6()
D EN^XUSHSHP
S $P(RECORD,U,9)=1
S $P(RECORD,U,7)=X
S ^OOPS(2260,IEN,"CA")=RECORD
D EMP^OOPSMBUL(IEN)
; patch 10 - bill of rights enhancement
I (CALLER="E")&('$$BROKER^XWBLIB) D
. D CONSENT
. I $$GET1^DIQ(2260,IEN,72,"I")="Y" D UNION
. I UNIREP D CONSENT^OOPSMBUL(IEN,UNIREP)
Q
SUP ;Supervisor Sign off
I FORM="CA1" S $P(^OOPS(2260,IEN,"CA1ES"),U,4,6)=SIGN
I FORM="CA2" S $P(^OOPS(2260,IEN,"CA2ES"),U,4,6)=SIGN
I FORM="2162" S $P(^OOPS(2260,IEN,"2162ES"),U,1,3)=SIGN D SAFETY^OOPSMBUL(IEN)
; Patch 8
I FORM'="2162" D SUPS^OOPSMBUL(IEN),UNION^OOPSMBUL(IEN)
Q
WCP ; Patch 8
I FORM="CA1" S $P(^OOPS(2260,IEN,"WCES"),U,1,3)=SIGN
I FORM="CA2" S $P(^OOPS(2260,IEN,"WCES"),U,1,3)=SIGN
N DA,DR,DIE
I $P(SIGN,U) D
. S DR="",DIE="^OOPS(2260,",DA=IEN
. S DR(1,2260,1)="67////^S X=$P(SIGN,U)"
. S DR(1,2260,5)="68////^S X=$P(SIGN,U,2)"
. S DR(1,2260,10)="69////^S X=$P(SIGN,U,3)"
. D ^DIE
D WCP^OOPSMBUL(IEN,"S")
Q
SAF ; Safety Officer Sign off
I FORM="2162" S $P(^OOPS(2260,IEN,"2162ES"),U,4,6)=SIGN
Q
CONSENT ; patch 10 - Employee consent to release information to union
N DIC,DIE,DA,DR,OOPS
S DA=IEN,DIC="^OOPS(2260,",OUT=""
K DIQ S DIQ(0)="IE"
S DIQ="OOPS",DR=".01;2;3;4;7;13;14;16;17;18;52;53;53.1" D EN^DIQ1
S DR=""
W !!,"My consent is given for the release of case number "_OOPS(2260,IEN,.01,"E")
W !,"information for review by local bargaining units for accident and"
W !,"illness tracking purposes only. Name, address, social security "
W !,"number, date of birth, and telephone number will not be included"
W !,"in the information provided to the bargaining units."
W !!,"With your consent, the following information will be provided"
W !,"to the local bargaining unit for your review."
W !!,"Dt/Tme Occurrence: ",OOPS(2260,IEN,4,"E")
W ?40," Inj/Ill: ",OOPS(2260,IEN,52,"E")
W !," Personnel Status: ",OOPS(2260,IEN,2,"E")
W ?40," Sex: ",OOPS(2260,IEN,7,"E")
W !," Station Number: ",OOPS(2260,IEN,13,"I")
W ?40," Education: ",$E(OOPS(2260,IEN,18,"E"),1,26)
W !," Cost Center/Org: ",OOPS(2260,IEN,14,"E")
W ?40," Grade/Stp: ",OOPS(2260,IEN,16,"E")_"/"_OOPS(2260,IEN,17,"E")
W !," Supervisor: ",$E(OOPS(2260,IEN,53,"E"),1,19)
W ?40,"Type Incid: ",$E(OOPS(2260,IEN,3,"E"),1,26)
W !," Secondary Super: ",$E(OOPS(2260,IEN,53.1,"E"),1,20),!
S DR(1,2260,1)="72Consent Given://^S X=""N"""
W !!?5,"If you give consent, you will be prompted to select the"
W !?5,"Union to send the bulletin to. The bulletin will be sent"
W !?5,"immediately after the Union has been selected.",!
S DIE="^OOPS(2260,"
D ^DIE I $D(Y) S OUT=1
Q
UNION ; Get the Union Representative's DUZ
N DIC,DA,Y
S DIC="^OOPS(2263.7,",DIC(0)="AEQZ"
S DIC("A")="Select UNION to send bulletin to: "
D ^DIC
I +Y S UNIREP=$$GET1^DIQ(2263.7,+Y,2,"I")
I 'UNIREP D
. W !!?3,"Cannot sent a bulletin to Union, No Union Representative name was selected"
. W !?3,"or one is not on file. Contact your Workers' Compensation Specialist."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSVAL1 8155 printed Dec 13, 2024@01:39:52 Page 2
OOPSVAL1 ;HINES/WAA,GTD-Validate and Sign data Routines ;3/25/98
+1 ;;2.0;ASISTS;;Jun 03, 2002
+2 ;;
+3 ; Note: At EMP+18 added check to see if code being executed from
+4 ; the broker. ASISTS V2.0
+5 ;
EN1(CALLER) ; Main Entry Point
+1 ;INPUT:
+2 ; CALLER = "E" FOR EMPLOYEE
+3 ; = "S" FOR SUPERVISOR
+4 ; = "O" FOR SAFETY OFFICER
+5 ; = "W" FOR WORKER'S COMP
+6 ;
+7 NEW SSN,IEN,SIGN,EDIT,FORM,GRP,SUP,I,CIT,HSA,STA,ZIP
+8 SET IEN=0
+9 if DUZ<1
QUIT
+10 if $GET(^VA(200,DUZ,1))=""
QUIT
+11 IF CALLER="E"
SET SSN=$PIECE(^VA(200,DUZ,1),U,9)
if $DATA(^OOPS(2260,"SSN",SSN))<1
QUIT
+12 Begin DoDot:1
+13 NEW DIC,X
+14 SET DIC="^OOPS(2260,"
+15 IF CALLER="E"
SET DIC("S")="I $$EMPSCR^OOPSVAL1(Y)"
+16 IF CALLER="S"
SET DIC("S")="I $$SUPSCR^OOPSVAL1(Y)"
+17 IF CALLER="O"
SET DIC("S")="I $$SAFSCR^OOPSVAL1(Y)"
+18 IF CALLER="W"
SET DIC("S")="I $$WCSCR^OOPSVAL1(Y)"
+19 SET DIC("S")=DIC("S")_",'$$GET1^DIQ(2260,Y,51,""I"")"
+20 SET DIC(0)="AEMNZ"
SET DIC("A")=" Select Case: "
+21 DO ^DIC
+22 if Y<1
QUIT
+23 if $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+24 SET IEN=$PIECE(Y,U)
+25 QUIT
End DoDot:1
if IEN<1
QUIT
+26 IF CALLER="O"
Begin DoDot:1
+27 SET FORM="2162"
+28 DO FORM
+29 QUIT
End DoDot:1
+30 IF CALLER="E"
Begin DoDot:1
+31 SET FORM=$$GET1^DIQ(2260,IEN,52,"I")
+32 SET FORM=$SELECT(FORM=1:"CA1",FORM=2:"CA2",1:"")
+33 IF FORM'=""
DO FORM
+34 QUIT
End DoDot:1
+35 IF CALLER="S"
Begin DoDot:1
+36 NEW CNT,PAUSE,OUT,FORM,EDIT
+37 SET (PAUSE,OUT)=0
+38 ; Do block below needed so that for loop below only runs for "S"
+39 Begin DoDot:2
+40 NEW INC,STAT,ESTAT
+41 SET INC=$$GET1^DIQ(2260,IEN,52,"I")
+42 SET STAT=$$EDSTA^OOPSUTL1(IEN,"S")
+43 ; added check for employee having signed CA1
+44 SET ESTAT=$$EDSTA^OOPSUTL1(IEN,"E")
+45 ; if employee signed ok to let super select if no forms signed
+46 IF $PIECE(ESTAT,U,INC)
Begin DoDot:3
+47 IF '$PIECE(STAT,U,INC)
IF '$PIECE(STAT,U,3)
DO SELECT^OOPSSUP1
QUIT
+48 SET EDIT=$SELECT('$PIECE(STAT,U,3):2162,'$PIECE(STAT,U,INC):$PIECE("CA1^CA2",U,INC),1:"")
End DoDot:3
+49 ; Employee has not signed CA1/CA2
IF '$PIECE(ESTAT,U,INC)
Begin DoDot:3
+50 IF '$PIECE(STAT,U,3)
SET EDIT=2162
QUIT
+51 SET EDIT=""
End DoDot:3
End DoDot:2
+52 IF EDIT=""
QUIT
+53 FOR CNT=1:1
SET FORM=$PIECE(EDIT,U,CNT)
if FORM=""
QUIT
if PAUSE
DO END
if OUT
QUIT
Begin DoDot:2
+54 DO FORM
SET PAUSE=1
+55 QUIT
End DoDot:2
+56 QUIT
End DoDot:1
+57 IF CALLER="W"
Begin DoDot:1
+58 SET FORM=$$GET1^DIQ(2260,IEN,52,"I")
+59 SET FORM=$SELECT(FORM=1:"CA1",FORM=2:"CA2",1:"")
+60 NEW DIR,Y
+61 SET WOK=1
+62 WRITE !
+63 SET DIR("A")="OK to transmit to DOL"
+64 SET DIR(0)="SBM^Y:Yes;N:No"
+65 DO ^DIR
+66 IF Y="Y"
IF FORM'=""
DO FORM
+67 QUIT
End DoDot:1
EXIT ;
+1 ; left over from ^OOPSDIS
KILL SUP,WOK
+2 QUIT
EMPSCR(IEN) ;
+1 NEW VIEW
+2 SET VIEW=1
+3 IF '$$EMP^OOPSUTL1(IEN,SSN)
SET VIEW=0
+4 IF '$TEST
Begin DoDot:1
+5 NEW INC
+6 SET INC=$$GET1^DIQ(2260,IEN,52,"I")
+7 IF $PIECE($$EDSTA^OOPSUTL1(IEN,"E"),U,INC)
SET VIEW=0
+8 QUIT
End DoDot:1
+9 QUIT VIEW
SUPSCR(IEN) ;
+1 NEW VIEW
+2 SET VIEW=1
+3 IF '$$SUPSCR^OOPSUTL2(DUZ,IEN)
SET VIEW=0
+4 IF '$TEST
Begin DoDot:1
+5 NEW INC,STAT,ESTAT,CAT
+6 ; Personnel status
SET CAT=$$GET1^DIQ(2260,IEN,2,"I")
+7 ; Injury/Illness
SET INC=$$GET1^DIQ(2260,IEN,52,"I")
+8 ; sup signed forms
SET STAT=$$EDSTA^OOPSUTL1(IEN,"S")
+9 ; emp signed forms
SET ESTAT=$$EDSTA^OOPSUTL1(IEN,"E")
+10 ; Added Non-PAID employee to check, not emp, 2162 signed
+11 ; Patch 5 - logic changed for new Personnel Categories
+12 IF '$$ISEMP^OOPSUTL4(IEN)
IF $PIECE(STAT,U,3)
SET VIEW=0
QUIT
+13 ; super signed 2162 and CA1/CA2
+14 IF $PIECE(STAT,U,INC)
IF $PIECE(STAT,U,3)
SET VIEW=0
QUIT
+15 ; emp not signed CA1/CA2, super signed 2162, not signed CA1/CA2 - no
+16 IF '$PIECE(ESTAT,U,INC)
IF $PIECE(STAT,U,3)
IF '$PIECE(STAT,U,INC)
SET VIEW=0
QUIT
+17 QUIT
End DoDot:1
+18 QUIT VIEW
WCSCR(IEN) ; Patch 8 - Worker's Comp Screen
+1 NEW INC,VIEW,ESTAT,STAT
+2 SET VIEW=1
+3 SET INC=$$GET1^DIQ(2260,IEN,52,"I")
+4 ;really defensive code
SET ESTAT=$$EDSTA^OOPSUTL1(IEN,"E")
+5 ;should never be needed
IF '$PIECE(ESTAT,U,INC)
SET VIEW=0
+6 ;super must have signed
SET STAT=$$EDSTA^OOPSUTL1(IEN,"S")
+7 IF '$PIECE(STAT,U,INC)
SET VIEW=0
+8 ;Case sent to DOL
IF $$GET1^DIQ(2260,IEN,66)'=""
SET VIEW=0
+9 ;WC already signed
IF $$GET1^DIQ(2260,IEN,67)'=""
SET VIEW=0
+10 ;Case is not open
IF $$GET1^DIQ(2260,IEN,51,"I")'=0
SET VIEW=0
+11 ;not employee
IF '$$ISEMP^OOPSUTL4(IEN)
SET VIEW=0
+12 QUIT VIEW
SAFSCR(IEN) ;
+1 NEW VIEW
+2 SET VIEW=1
+3 IF '$$SAFETY^OOPSUTL2(IEN)
SET VIEW=0
+4 IF $$EDSTA^OOPSUTL1(IEN,"O")
SET VIEW=0
+5 QUIT VIEW
END ;End of Form pause
+1 NEW DIR
+2 WRITE !
+3 SET DIR(0)="E"
DO ^DIR
+4 if $DATA(DIRUT)
SET OUT=1
QUIT
+5 QUIT
FORM ;Select Form
+1 if '$GET(PAUSE,0)
DO ^OOPSDIS
+2 NEW OUT
+3 IF CALLER="E"
Begin DoDot:1
+4 IF $$GET1^DIQ(2260,IEN,71,"I")'="Y"
DO BOR^OOPSEMP1
+5 IF $$GET1^DIQ(2260,IEN,71,"I")'="Y"
Begin DoDot:2
+6 WRITE !?5,"Claim cannot be signed until the Bill of Rights Statement is understood."
+7 DO WCPBOR^OOPSMBUL(IEN)
+8 SET OUT=1
End DoDot:2
QUIT
End DoDot:1
if $GET(OUT)
QUIT
+9 IF '$GET(OUT)
DO SIGN(FORM)
if (+SIGN=0)
QUIT
+10 IF CALLER="E"
IF ($$GET1^DIQ(2260,IEN,71,"I")="Y")
DO EMP
+11 IF CALLER="S"
DO SUP
+12 IF CALLER="O"
DO SAF
+13 IF CALLER="W"
DO WCP
+14 QUIT
SIGN(FORM) ; Sign/validate Document
+1 NEW EMP,INC,VALID,OUT
+2 SET VALID=0
SET SIGN=""
+3 SET INC=$$GET1^DIQ(2260,IEN,52,"I")
+4 DO VALIDATE^OOPSUTL4(IEN,FORM,CALLER,.VALID)
+5 IF 'VALID
DO END
QUIT
+6 SET SIGN=$$SIG^OOPSESIG(DUZ,IEN)
+7 QUIT
EMP ; Employee Sign off
+1 NEW RECORD,UNIREP,X,X1,X2
+2 SET UNIREP=""
+3 SET RECORD=$GET(^OOPS(2260,IEN,"CA"))
+4 SET X=$PIECE($GET(^VA(200,DUZ,20)),U,2)
+5 SET X1=DUZ
+6 IF FORM="CA1"
Begin DoDot:1
+7 IF '$$BROKER^XWBLIB
SET $PIECE(^OOPS(2260,IEN,"CA1ES"),U,1,3)=SIGN
+8 SET X2=$$CA1SUM^OOPSUTL6()
End DoDot:1
+9 IF FORM="CA2"
Begin DoDot:1
+10 IF '$$BROKER^XWBLIB
SET $PIECE(^OOPS(2260,IEN,"CA2ES"),U,1,3)=SIGN
+11 SET X2=$$CA2SUM^OOPSUTL6()
End DoDot:1
+12 DO EN^XUSHSHP
+13 SET $PIECE(RECORD,U,9)=1
+14 SET $PIECE(RECORD,U,7)=X
+15 SET ^OOPS(2260,IEN,"CA")=RECORD
+16 DO EMP^OOPSMBUL(IEN)
+17 ; patch 10 - bill of rights enhancement
+18 IF (CALLER="E")&('$$BROKER^XWBLIB)
Begin DoDot:1
+19 DO CONSENT
+20 IF $$GET1^DIQ(2260,IEN,72,"I")="Y"
DO UNION
+21 IF UNIREP
DO CONSENT^OOPSMBUL(IEN,UNIREP)
End DoDot:1
+22 QUIT
SUP ;Supervisor Sign off
+1 IF FORM="CA1"
SET $PIECE(^OOPS(2260,IEN,"CA1ES"),U,4,6)=SIGN
+2 IF FORM="CA2"
SET $PIECE(^OOPS(2260,IEN,"CA2ES"),U,4,6)=SIGN
+3 IF FORM="2162"
SET $PIECE(^OOPS(2260,IEN,"2162ES"),U,1,3)=SIGN
DO SAFETY^OOPSMBUL(IEN)
+4 ; Patch 8
+5 IF FORM'="2162"
DO SUPS^OOPSMBUL(IEN)
DO UNION^OOPSMBUL(IEN)
+6 QUIT
WCP ; Patch 8
+1 IF FORM="CA1"
SET $PIECE(^OOPS(2260,IEN,"WCES"),U,1,3)=SIGN
+2 IF FORM="CA2"
SET $PIECE(^OOPS(2260,IEN,"WCES"),U,1,3)=SIGN
+3 NEW DA,DR,DIE
+4 IF $PIECE(SIGN,U)
Begin DoDot:1
+5 SET DR=""
SET DIE="^OOPS(2260,"
SET DA=IEN
+6 SET DR(1,2260,1)="67////^S X=$P(SIGN,U)"
+7 SET DR(1,2260,5)="68////^S X=$P(SIGN,U,2)"
+8 SET DR(1,2260,10)="69////^S X=$P(SIGN,U,3)"
+9 DO ^DIE
End DoDot:1
+10 DO WCP^OOPSMBUL(IEN,"S")
+11 QUIT
SAF ; Safety Officer Sign off
+1 IF FORM="2162"
SET $PIECE(^OOPS(2260,IEN,"2162ES"),U,4,6)=SIGN
+2 QUIT
CONSENT ; patch 10 - Employee consent to release information to union
+1 NEW DIC,DIE,DA,DR,OOPS
+2 SET DA=IEN
SET DIC="^OOPS(2260,"
SET OUT=""
+3 KILL DIQ
SET DIQ(0)="IE"
+4 SET DIQ="OOPS"
SET DR=".01;2;3;4;7;13;14;16;17;18;52;53;53.1"
DO EN^DIQ1
+5 SET DR=""
+6 WRITE !!,"My consent is given for the release of case number "_OOPS(2260,IEN,.01,"E")
+7 WRITE !,"information for review by local bargaining units for accident and"
+8 WRITE !,"illness tracking purposes only. Name, address, social security "
+9 WRITE !,"number, date of birth, and telephone number will not be included"
+10 WRITE !,"in the information provided to the bargaining units."
+11 WRITE !!,"With your consent, the following information will be provided"
+12 WRITE !,"to the local bargaining unit for your review."
+13 WRITE !!,"Dt/Tme Occurrence: ",OOPS(2260,IEN,4,"E")
+14 WRITE ?40," Inj/Ill: ",OOPS(2260,IEN,52,"E")
+15 WRITE !," Personnel Status: ",OOPS(2260,IEN,2,"E")
+16 WRITE ?40," Sex: ",OOPS(2260,IEN,7,"E")
+17 WRITE !," Station Number: ",OOPS(2260,IEN,13,"I")
+18 WRITE ?40," Education: ",$EXTRACT(OOPS(2260,IEN,18,"E"),1,26)
+19 WRITE !," Cost Center/Org: ",OOPS(2260,IEN,14,"E")
+20 WRITE ?40," Grade/Stp: ",OOPS(2260,IEN,16,"E")_"/"_OOPS(2260,IEN,17,"E")
+21 WRITE !," Supervisor: ",$EXTRACT(OOPS(2260,IEN,53,"E"),1,19)
+22 WRITE ?40,"Type Incid: ",$EXTRACT(OOPS(2260,IEN,3,"E"),1,26)
+23 WRITE !," Secondary Super: ",$EXTRACT(OOPS(2260,IEN,53.1,"E"),1,20),!
+24 SET DR(1,2260,1)="72Consent Given://^S X=""N"""
+25 WRITE !!?5,"If you give consent, you will be prompted to select the"
+26 WRITE !?5,"Union to send the bulletin to. The bulletin will be sent"
+27 WRITE !?5,"immediately after the Union has been selected.",!
+28 SET DIE="^OOPS(2260,"
+29 DO ^DIE
IF $DATA(Y)
SET OUT=1
+30 QUIT
UNION ; Get the Union Representative's DUZ
+1 NEW DIC,DA,Y
+2 SET DIC="^OOPS(2263.7,"
SET DIC(0)="AEQZ"
+3 SET DIC("A")="Select UNION to send bulletin to: "
+4 DO ^DIC
+5 IF +Y
SET UNIREP=$$GET1^DIQ(2263.7,+Y,2,"I")
+6 IF 'UNIREP
Begin DoDot:1
+7 WRITE !!?3,"Cannot sent a bulletin to Union, No Union Representative name was selected"
+8 WRITE !?3,"or one is not on file. Contact your Workers' Compensation Specialist."
End DoDot:1
+9 QUIT
