OOPSUTL6 ;WOIFO/LLH-Utilities Routines ;11/21/00
;;2.0;ASISTS;;Jun 03, 2002
;;
Q
VERIFY(IEN) ; Verify Employee data has not been altered since thier signing
;
; Input IEN - Internal Record Number of Case
; Code expects Employee, Supervisor, and WCP e-signatures
;
N CALL,DOL,FORM,RECORD,SIG,STR,VALID,VER,X,X1,X2,WCP
S VALID=1
S FORM="CA"_$$GET1^DIQ(2260,IEN,52,"I")
S RECORD=$G(^OOPS(2260,IEN,"CA"))
S VER=$P(RECORD,U,9),X=$P(RECORD,U,7)
I '$G(VER)&('$G(X)) Q 1 ; employee signed before patch, change??
I VER'=1 Q ""
I FORM="CA1" S X1=$$GET1^DIQ(2260,IEN,119,"I"),X2=$$CA1SUM^OOPSUTL6()
I FORM="CA2" S X1=$$GET1^DIQ(2260,IEN,221,"I"),X2=$$CA2SUM^OOPSUTL6()
D DE^XUSHSHP
I $G(X1)="" Q ""
S VALID=(X=$P($G(^VA(200,X1,20)),U,2))
I 'VALID D
. K XMY,XMB
. S DOL=1
. S WCP="" F S WCP=$O(^OOPS(2260,"AW",WCP)) Q:WCP="" I $D(^OOPS(2260,"AW",WCP,IEN)) K ^OOPS(2260,"AW",WCP,IEN)
. S STR=$G(^OOPS(2260,IEN,FORM_"ES")) ; send bulletins to
. I $P(STR,U)=""!($P(STR,U,4)="") Q
. S XMB="OOPS SIGNATURE SECURITY"
. S XMB(2)=$P($G(^OOPS(2260,IEN,0)),U) ; claim number
. S XMY($P(STR,U))="",XMY($P(STR,U,4))="" ; emp, supervisor, WCP
. S XMY($P($G(^OOPS(2260,IEN,"WCES")),U))=""
. D ^XMB K XMB,XMY,XMM,XMDT
. F CALL="E","S","W" D CLRES^OOPSUTL1(IEN,CALL,FORM)
Q VALID
CA1SUM() ; Calculate Checksum for CA1 for all employee fields on page 1
N I,J,K,OOPS,STR,SUM,WITN,X
S J=1
S OOPS(0)=$G(^OOPS(2260,IEN,0))
S OOPS("2162A")=$G(^OOPS(2260,IEN,"2162A"))
S OOPS("CA1A")=$G(^OOPS(2260,IEN,"CA1A"))
S OOPS("CA1B")=$P($G(^OOPS(2260,IEN,"CA1B")),U)
S OOPS("CA1C")=$P($G(^OOPS(2260,IEN,"CA1C")),U)
S OOPS("CA1N")=$G(^OOPS(2260,IEN,"CA1N"))
S STR(J)=$P(OOPS(0),U,2),J=J+1
F I=1,2,3,8,12,13,4,5,6,7 S STR(J)=$P(OOPS("2162A"),U,I),J=J+1
F I=8,9,10 S STR(J)=$P(OOPS("CA1A"),U,I),J=J+1
F I=1:1:3 S STR(J)=$P(OOPS("CA1N"),U,I),J=J+1
S STR(J)=$P(OOPS(0),U,5),J=J+1
F I=11,12 S STR(J)=$P(OOPS("CA1A"),U,I),J=J+1
S STR(J)=OOPS("CA1B"),J=J+1
S STR(J)=$P($G(^OOPS(2260,IEN,"CA")),U),J=J+1
S STR(J)=OOPS("CA1C"),J=J+1
S STR(J)=$P(OOPS("CA1A"),U,13),J=J+1
S SUM=0 F K=1:1:J I $D(STR(K)) F I=1:1:$L(STR(K)) S SUM=$A(STR(K),I)*I+SUM
Q SUM
CA2SUM() ; Calculate Checksum for CA2
N I,J,K,OPFLD,OOPS,STR,SUM,X
S J=1
S OOPS(0)=$G(^OOPS(2260,IEN,0))
S OOPS("2162A")=$G(^OOPS(2260,IEN,"2162A"))
S OOPS("CA2A")=$G(^OOPS(2260,IEN,"CA2A"))
S OOPS("CA2B")=$G(^OOPS(2260,IEN,"CA2B"))
S STR(J)=$P(OOPS(0),U,2),J=J+1
F I=1,2,3,8,12,13,4,5,6,7 S STR(J)=$P(OOPS("2162A"),U,I),J=J+1
F I=8,9 S STR(J)=$P(OOPS("CA2A"),U,I),J=J+1
F I=1:1:7 S STR(J)=$P(OOPS("CA2B"),U,I),J=J+1
S STR(J)=$P($G(^OOPS(2260,IEN,"CA")),U),J=J+1
F OPFLD=216,217,218,219,220 D WP
S SUM=0 F K=1:1:J I $D(STR(K)) F I=1:1:$L(STR(K)) S SUM=$A(STR(K),I)*I+SUM
Q SUM
VALEMP() ; check to make sure claim is ok to send to DOL if pay plan = "OT"
; this subroutine assumes that the variable FORM will be defined
N IEN450,LP,NA,SAL,VALID
S VALID=1,LP=0
S NA=$$GET1^DIQ(2260,IEN,1)
S SAL=$$GET1^DIQ(2260,IEN,166)
I $$GET1^DIQ(2260,IEN,60,"I")'=3 S VALID=0
I $$GET1^DIQ(2260,IEN,16,"I")'="00" S VALID=0
I $$GET1^DIQ(2260,IEN,17,"I")'="N" S VALID=0
I (FORM="CA1")&(('SAL)!(SAL>999.99)) S VALID=0
D FIND^DIC(450,,"@;8","MPS",NA,100)
I $G(DIERR) D CLEAN^DILF S VALID=0 Q VALID
F S LP=$O(^TMP("DILIST",$J,LP)) Q:LP="" D
.I $$GET1^DIQ(2260,IEN,5)=$P(^TMP("DILIST",$J,LP,0),U,2) D
..S IEN450=$P(^TMP("DILIST",$J,LP,0),U)
..I '$G(IEN450) S VALID=0 Q
..I $$GET1^DIQ(450,IEN450,20,"I")'="F" S VALID=0
Q VALID
;
WP ;Process Word Processing Fields
N DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC,X
K ^UTILITY($J,"W")
S DIWL=1,DIWR="",DIWF="|C132"
S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
S OPGLB="^OOPS(2260,IEN,OPNODE,OPI)"
S OPI=0 F S OPI=$O(@OPGLB) Q:'OPI S X=$G(^(OPI,0)) D
. I $TR(X," ","")="" Q
. I X]"" D ^DIWP
S OPT=$G(^UTILITY($J,"W",1))+0
I OPT S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI D
. S STR(J)=^UTILITY($J,"W",1,OPI,0),J=J+1
K ^UTILITY($J,"W")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSUTL6 4128 printed Oct 16, 2024@17:40:41 Page 2
OOPSUTL6 ;WOIFO/LLH-Utilities Routines ;11/21/00
+1 ;;2.0;ASISTS;;Jun 03, 2002
+2 ;;
+3 QUIT
VERIFY(IEN) ; Verify Employee data has not been altered since thier signing
+1 ;
+2 ; Input IEN - Internal Record Number of Case
+3 ; Code expects Employee, Supervisor, and WCP e-signatures
+4 ;
+5 NEW CALL,DOL,FORM,RECORD,SIG,STR,VALID,VER,X,X1,X2,WCP
+6 SET VALID=1
+7 SET FORM="CA"_$$GET1^DIQ(2260,IEN,52,"I")
+8 SET RECORD=$GET(^OOPS(2260,IEN,"CA"))
+9 SET VER=$PIECE(RECORD,U,9)
SET X=$PIECE(RECORD,U,7)
+10 ; employee signed before patch, change??
IF '$GET(VER)&('$GET(X))
QUIT 1
+11 IF VER'=1
QUIT ""
+12 IF FORM="CA1"
SET X1=$$GET1^DIQ(2260,IEN,119,"I")
SET X2=$$CA1SUM^OOPSUTL6()
+13 IF FORM="CA2"
SET X1=$$GET1^DIQ(2260,IEN,221,"I")
SET X2=$$CA2SUM^OOPSUTL6()
+14 DO DE^XUSHSHP
+15 IF $GET(X1)=""
QUIT ""
+16 SET VALID=(X=$PIECE($GET(^VA(200,X1,20)),U,2))
+17 IF 'VALID
Begin DoDot:1
+18 KILL XMY,XMB
+19 SET DOL=1
+20 SET WCP=""
FOR
SET WCP=$ORDER(^OOPS(2260,"AW",WCP))
if WCP=""
QUIT
IF $DATA(^OOPS(2260,"AW",WCP,IEN))
KILL ^OOPS(2260,"AW",WCP,IEN)
+21 ; send bulletins to
SET STR=$GET(^OOPS(2260,IEN,FORM_"ES"))
+22 IF $PIECE(STR,U)=""!($PIECE(STR,U,4)="")
QUIT
+23 SET XMB="OOPS SIGNATURE SECURITY"
+24 ; claim number
SET XMB(2)=$PIECE($GET(^OOPS(2260,IEN,0)),U)
+25 ; emp, supervisor, WCP
SET XMY($PIECE(STR,U))=""
SET XMY($PIECE(STR,U,4))=""
+26 SET XMY($PIECE($GET(^OOPS(2260,IEN,"WCES")),U))=""
+27 DO ^XMB
KILL XMB,XMY,XMM,XMDT
+28 FOR CALL="E","S","W"
DO CLRES^OOPSUTL1(IEN,CALL,FORM)
End DoDot:1
+29 QUIT VALID
CA1SUM() ; Calculate Checksum for CA1 for all employee fields on page 1
+1 NEW I,J,K,OOPS,STR,SUM,WITN,X
+2 SET J=1
+3 SET OOPS(0)=$GET(^OOPS(2260,IEN,0))
+4 SET OOPS("2162A")=$GET(^OOPS(2260,IEN,"2162A"))
+5 SET OOPS("CA1A")=$GET(^OOPS(2260,IEN,"CA1A"))
+6 SET OOPS("CA1B")=$PIECE($GET(^OOPS(2260,IEN,"CA1B")),U)
+7 SET OOPS("CA1C")=$PIECE($GET(^OOPS(2260,IEN,"CA1C")),U)
+8 SET OOPS("CA1N")=$GET(^OOPS(2260,IEN,"CA1N"))
+9 SET STR(J)=$PIECE(OOPS(0),U,2)
SET J=J+1
+10 FOR I=1,2,3,8,12,13,4,5,6,7
SET STR(J)=$PIECE(OOPS("2162A"),U,I)
SET J=J+1
+11 FOR I=8,9,10
SET STR(J)=$PIECE(OOPS("CA1A"),U,I)
SET J=J+1
+12 FOR I=1:1:3
SET STR(J)=$PIECE(OOPS("CA1N"),U,I)
SET J=J+1
+13 SET STR(J)=$PIECE(OOPS(0),U,5)
SET J=J+1
+14 FOR I=11,12
SET STR(J)=$PIECE(OOPS("CA1A"),U,I)
SET J=J+1
+15 SET STR(J)=OOPS("CA1B")
SET J=J+1
+16 SET STR(J)=$PIECE($GET(^OOPS(2260,IEN,"CA")),U)
SET J=J+1
+17 SET STR(J)=OOPS("CA1C")
SET J=J+1
+18 SET STR(J)=$PIECE(OOPS("CA1A"),U,13)
SET J=J+1
+19 SET SUM=0
FOR K=1:1:J
IF $DATA(STR(K))
FOR I=1:1:$LENGTH(STR(K))
SET SUM=$ASCII(STR(K),I)*I+SUM
+20 QUIT SUM
CA2SUM() ; Calculate Checksum for CA2
+1 NEW I,J,K,OPFLD,OOPS,STR,SUM,X
+2 SET J=1
+3 SET OOPS(0)=$GET(^OOPS(2260,IEN,0))
+4 SET OOPS("2162A")=$GET(^OOPS(2260,IEN,"2162A"))
+5 SET OOPS("CA2A")=$GET(^OOPS(2260,IEN,"CA2A"))
+6 SET OOPS("CA2B")=$GET(^OOPS(2260,IEN,"CA2B"))
+7 SET STR(J)=$PIECE(OOPS(0),U,2)
SET J=J+1
+8 FOR I=1,2,3,8,12,13,4,5,6,7
SET STR(J)=$PIECE(OOPS("2162A"),U,I)
SET J=J+1
+9 FOR I=8,9
SET STR(J)=$PIECE(OOPS("CA2A"),U,I)
SET J=J+1
+10 FOR I=1:1:7
SET STR(J)=$PIECE(OOPS("CA2B"),U,I)
SET J=J+1
+11 SET STR(J)=$PIECE($GET(^OOPS(2260,IEN,"CA")),U)
SET J=J+1
+12 FOR OPFLD=216,217,218,219,220
DO WP
+13 SET SUM=0
FOR K=1:1:J
IF $DATA(STR(K))
FOR I=1:1:$LENGTH(STR(K))
SET SUM=$ASCII(STR(K),I)*I+SUM
+14 QUIT SUM
VALEMP() ; check to make sure claim is ok to send to DOL if pay plan = "OT"
+1 ; this subroutine assumes that the variable FORM will be defined
+2 NEW IEN450,LP,NA,SAL,VALID
+3 SET VALID=1
SET LP=0
+4 SET NA=$$GET1^DIQ(2260,IEN,1)
+5 SET SAL=$$GET1^DIQ(2260,IEN,166)
+6 IF $$GET1^DIQ(2260,IEN,60,"I")'=3
SET VALID=0
+7 IF $$GET1^DIQ(2260,IEN,16,"I")'="00"
SET VALID=0
+8 IF $$GET1^DIQ(2260,IEN,17,"I")'="N"
SET VALID=0
+9 IF (FORM="CA1")&(('SAL)!(SAL>999.99))
SET VALID=0
+10 DO FIND^DIC(450,,"@;8","MPS",NA,100)
+11 IF $GET(DIERR)
DO CLEAN^DILF
SET VALID=0
QUIT VALID
+12 FOR
SET LP=$ORDER(^TMP("DILIST",$JOB,LP))
if LP=""
QUIT
Begin DoDot:1
+13 IF $$GET1^DIQ(2260,IEN,5)=$PIECE(^TMP("DILIST",$JOB,LP,0),U,2)
Begin DoDot:2
+14 SET IEN450=$PIECE(^TMP("DILIST",$JOB,LP,0),U)
+15 IF '$GET(IEN450)
SET VALID=0
QUIT
+16 IF $$GET1^DIQ(450,IEN450,20,"I")'="F"
SET VALID=0
End DoDot:2
End DoDot:1
+17 QUIT VALID
+18 ;
WP ;Process Word Processing Fields
+1 NEW DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC,X
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWL=1
SET DIWR=""
SET DIWF="|C132"
+4 SET OPNODE=$PIECE($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
+5 SET OPGLB="^OOPS(2260,IEN,OPNODE,OPI)"
+6 SET OPI=0
FOR
SET OPI=$ORDER(@OPGLB)
if 'OPI
QUIT
SET X=$GET(^(OPI,0))
Begin DoDot:1
+7 IF $TRANSLATE(X," ","")=""
QUIT
+8 IF X]""
DO ^DIWP
End DoDot:1
+9 SET OPT=$GET(^UTILITY($JOB,"W",1))+0
+10 IF OPT
SET OPI=0
FOR OPC=1:1
SET OPI=$ORDER(^UTILITY($JOB,"W",1,OPI))
if 'OPI
QUIT
Begin DoDot:1
+11 SET STR(J)=^UTILITY($JOB,"W",1,OPI,0)
SET J=J+1
End DoDot:1
+12 KILL ^UTILITY($JOB,"W")
+13 QUIT
