OOPSUTL4 ;HINES/WAA-Utilities Routines ;3/24/98
;;2.0;ASISTS;**7,15**;Jun 03, 2002;Build 9
DTVAL(DATE,FLD1,FLD2) ;
; this subroutine called from ^DD so date error checking on fields
; 143, 144, 145 (if CA1) and 254, 255 (if CA2). returns a valid date
; (one passed in) if a date in FLD2 and is > than date passed in (DATE).
; Inputs: DATE - date entered in prompt
; FLD1 - field of prompt date entered in
; FLD2 - field of date to be checked against
; Outputs: VAL - contains valid date passed in if true & "" if false
N DTE2,VAL
S VAL=DATE,DTE2=""
I '$G(IEN) S IEN=$G(DA)
I IEN S DTE2=$$GET1^DIQ(2260,IEN,FLD2,"I")
I %DT'["R" S DTE2=DTE2\1
I DTE2>DATE!'$G(DTE2) S VAL=""
I 'VAL D
.;V2_P15 changed direct writes with call to EN^DDIOL
.I '$G(DTE2) D EN^DDIOL($$GET1^DID(2260,FLD2,"","LABEL")_" cannot be blank if date entered in "_$$GET1^DID(2260,FLD1,"","LABEL"),"","!!!?5")
.D EN^DDIOL($$GET1^DID(2260,FLD1,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,FLD2,"","LABEL"),"","!!!?5")
Q VAL
VALIDATE(IEN,FORM,CALLER,VALID) ;
; Input: IEN = Internal Entry Number of entry in file 2260
; FORM = 2162,CA1, or CA2
; CALLER = "E" employee
; = "S" supervisor
; = "O" safety officer
; = "W" worker's comp personnel
; WCEMP = from menu if 1 - need to execute emp validation
; VALID = RESERVED FOR OUTPUT DATA
; Output:VALID = 1 ALL REQUIRED DATA FOR FORM IS COMPLETE
; = 0 DATA IS MISSING
N LIST,FLD,CNT,CHK
S (FLD,LIST)=""
S VALID=1,CHK=0,WCEMP=$G(WCEMP,0)
W !,"Validating data on form ",FORM,"."
I CALLER="E"!$G(WCEMP) D EMP
I CALLER="S" D SUP
I CALLER="O" D SOF
I CALLER="W" D WCP
F CNT=1:1 S FLD=$P(LIST,",",CNT) Q:FLD="" D
.N LOC,NODE,PCE,BADFLD,TEXT,WP
.S BADFLD=1,WP=0
.S LOC=$$GET1^DID(2260,FLD,"","GLOBAL SUBSCRIPT LOCATION")
.S NODE=$P(LOC,";"),PCE=$P(LOC,";",2)
.I PCE=0 D ;Work processing field
..I '$D(^OOPS(2260,IEN,NODE,1,0)) S (BADFLD,VALID)=0
..S WP=1
..Q
.I PCE'=0 I $P($G(^OOPS(2260,IEN,NODE)),U,PCE)="" S (BADFLD,VALID)=0
.I 'BADFLD D ; Display error messaged about fields not filled.
..I 'CHK W !!,"The following fields must be completed before the "_FORM_" can be signed.",! S CHK=1
..I WP D ;Is this a wp field and where to get title
...N NODE
...S NODE=2260_".0"_FLD
...; patch 11 - fix bug on fld 40, node '= 2260.040, it's 2260.01
...I FLD=40 S NODE="2260.01"
...S TEXT=$$GET1^DID(NODE,".01","","TITLE")
..I 'WP S TEXT=$$GET1^DID(2260,FLD,"","TITLE") I $G(TEXT)="" S TEXT=$$GET1^DID(2260,FLD,"","LABEL")
..; patch 2.7 - if body part affected - indicate the form
..I FLD=30,(TEXT'="") S TEXT=TEXT_" (FORM 2162)"
..W !,TEXT
I FORM="CA1"&(CALLER="E"!$G(WCEMP)) D ; fld 110 check on Emp CA1 only
.I $$GET1^DIQ(2260,IEN,110,"I")<($$GET1^DIQ(2260,IEN,4,"I")\1) S VALID=0 D
..W !?5,$$GET1^DID(2260,110,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,4,"","LABEL")
DTCHK ; Date error checking that may be missed w/input transform
; patch 11 - Additional error checking has been added for CA2 field 214
I FORM=2162!(CALLER="O")!$G(WCEMP) Q
K CNT,FLD,LIST
N DATE,DTE1,DTE2,TITLE,EMPDOB
; patch 11 - need to make sure 215 not before 214 on employee part
I CALLER="E",FORM="CA2" D Q
.S DTE1=$$GET1^DIQ(2260,IEN,215,"I")
.S DTE2=$$GET1^DIQ(2260,IEN,214,"I")
.S EMPDOB=$$GET1^DIQ(2260,IEN,6,"I")
.I $$FMDIFF^XLFDT(DTE2,EMPDOB,2)<0 S VALID=0 D
..W !?5,$$GET1^DID(2260,214,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,6,"","LABEL")
.I $$FMDIFF^XLFDT(DTE1,DTE2,2)<0 S VALID=0 D
..W !?5,$$GET1^DID(2260,215,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,214,"","LABEL")
; End of checks from Employee CA2
I FORM="CA1" D
.S LIST="142,161,175"
.S (DATE,DTE1)=$$GET1^DIQ(2260,IEN,4,"I")
.S TITLE=$$GET1^DID(2260,4,"","LABEL")
I FORM="CA2" D
.S LIST="215,250,252,253,255"
.S (DATE,DTE1)=$$GET1^DIQ(2260,IEN,214,"I")
.S TITLE=$$GET1^DID(2260,214,"","LABEL")
F CNT=1:1 S FLD=$P(LIST,",",CNT) Q:FLD="" D
.S DTE2=$$GET1^DIQ(2260,IEN,FLD,"I") I FLD'=142 S DTE2=DTE2\1,DTE1=DATE\1
.I $G(DTE2),DTE2<DTE1 D S VALID=0
..W !?5,$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE
; Need specific check on DATE/TIME STOPPED WORK
I FORM="CA1" D
.S LIST="143,144,145",DATE=$$GET1^DIQ(2260,IEN,142,"I")
.S TITLE=$$GET1^DID(2260,142,"","LABEL")
I FORM="CA2" D
.S LIST="254,256",DATE=$$GET1^DIQ(2260,IEN,253,"I")
.S TITLE=$$GET1^DID(2260,253,"","LABEL")
F CNT=1:1 S FLD=$P(LIST,",",CNT) Q:FLD="" D
.S DTE2=$$GET1^DIQ(2260,IEN,FLD,"I"),DTE1=DATE D
..I FLD=143!(FLD=144) S DTE1=DATE\1,DTE2=DTE2\1
..I (DTE1>DTE2),$G(DTE2) D S VALID=0
...W !?5,$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE
..I '$G(DTE1),$G(DTE2) D S VALID=0
...W !?5,TITLE_" cannot be blank if date in "_$$GET1^DID(2260,FLD,"","LABEL")
Q
EMP ; Address fields are now all pulled from the 2162A node
; added fields 126 & 181,183-185 to lists below - patch 8
I FORM="CA1" S LIST="8,9,10,11,12,108,109,110,111,112,113,114,126,181,183,184,185"
; added field 213 - ASISTS V2.0
I FORM="CA2" S LIST="8,9,10,11,12,126,208,213,209,214,215,216,217"
Q
SUP ;
N F165
I FORM="2162" D F2162 I $$ISEMP^OOPSUTL4(IEN) S LIST=LIST_",33" Q
S LIST="30,"
I FORM="CA1" D
.S LIST=LIST_"4,60,130,131,132,133,134,138,139,140,146,148,150,"
.S LIST=LIST_"162,163,172,173,174,175,176,177,178,179,"
.S LIST=LIST_"180,181,183,184,185,"
.I $$GET1^DIQ(2260,IEN,150,"I")="Y" S LIST=LIST_"151,152,153,154,155,"
.; V2.0 added required fields missed in patch 8
.I $$GET1^DIQ(2260,IEN,146)="No" S LIST=LIST_"147,"
.I $$GET1^DIQ(2260,IEN,148)="Yes" S LIST=LIST_"149,"
.I $$GET1^DIQ(2260,IEN,163)="No" S LIST=LIST_"164,"
.S F165=$G(^OOPS(2260,IEN,"CA1K",0))
.I $G(F165)'="",($P(F165,U,4)'=0) S LIST=LIST_"165,"
I FORM="CA2" D
.S LIST=LIST_"230,231,232,233,234,237,238,239,240,241,"
.S LIST=LIST_"242,243,244,251,252,255,258,60,268,269,"
.; below for ASISTS V2.0, needed for roll and scroll also
.; added next line, need to get 3rd party if 258 = y
.I $$GET1^DIQ(2260,IEN,258,"I")="Y" S LIST=LIST_"259,260,261,262,263,"
; V2.0 if field 60="other" (3) then 61 required for both CA1 & CA2
I $$GET1^DIQ(2260,IEN,60,"I")=3 S LIST=LIST_"61,"
; need to check physician information
D PHYCHK^OOPSGUI9
Q
SOF ;
I FORM="2162" D F2162 S LIST=LIST_",55,47"
Q
WCP ; Get required fields for Workers Comp
I FORM="2162" D F2162 Q
S LIST="5,6,7,15,62,70,73,"
I FORM="CA1" D
. S LIST=LIST_"123,124,"
. ; flds 166 & 167 only required if personnel status = 1
. I $$GET1^DIQ(2260,IEN,2,"I")=1 S LIST=LIST_"166,167,"
I FORM="CA2" D
. S LIST=LIST_"226,227,"
D SUP
Q
F2162 ; Set required fields for form 2162 - doesn't matter which menu
; coming from, Supervisor, Safety, WC (for EDIT REPORT OF INCIDENT)
N TYP,SAF
I FORM'="2162" Q
S LIST="26,27,28,29,30,31"
S TYP=$$GET1^DIQ(2260,IEN,"3:.01","E")
I "^Sharps Exposure^Hollow Bore Needlestick^Suture Needlestick^"[TYP D
. S LIST=LIST_",34,35,36,37,38,82"
I $$GET1^DIQ(2260,IEN,"38:2","I")="N" S LIST=LIST_",83"
I "^Exposure to Body Fluids/Splash^"[TYP D
. S LIST=LIST_",34,39,40,41"
I $$GET1^DIQ(2260,IEN,3,"I")<11 Q
I $$GET1^DIQ(2260,IEN,42.5,"I")="Y" S LIST=LIST_",42"
S SAF=$$GET1^DIQ(2260,IEN,43,"I")
S LIST=$S(SAF="Y":LIST_",84,87",SAF="N":LIST_",85",1:LIST)
S LIST=LIST_",47"
Q
UP(IN) ; Translate all lower to upper
N OUT
S OUT=$TR(IN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q OUT
VCHAR(IN) ; Check to make sure no invalid characters have been used
; input - IN, data entered by user
; output - VALID, if invalid characters used, = 0
N VALID
S VALID=1
I IN'=$TR(IN,"~`@#$%*_|\}{[]><","") S VALID=0
Q VALID
ISEMP(IEN) ; Determine if PERSONNEL STATUS = employee
; Input - IEN = internal Entry Number of case in File 2260
; CAT = Personnel Status of Case in File 2260
; TST = valid Personnel status categories for employee
; Output - EMP = 1 Personnel status indicates employee
; 0 Personnel status indicates non-employee
NEW CAT,TST,EMP
S EMP=0
S CAT=$$GET1^DIQ(2260,IEN,2,"I")
; 12/16/01 V2.0 removed personnel types 7,8,9,10
S TST=",1,2,6,"
I TST[(","_CAT_",") S EMP=1
Q EMP
FUT(DATE) ; Check for dates prior to Date of Inj/Ill
N DAT,VIEW,FORM
S VIEW=1
S FORM=$$GET1^DIQ(2260,IEN,52,"I")
S DAT=$$GET1^DIQ(2260,IEN,4,"I")
I (DATE<$P(DAT,".")),FORM=1 D
. W !!?6,"This date cannot be prior to DATE/TIME INJURY OCCURRED entered on 2162.",! S VIEW=0
Q VIEW
WP(OPFLD) ; Patch 8 - determine number of characters in WP fields that are
; limited to 532 characters & if invalid characters are present
; Input IEN - Internal Record ID of Case
; OPFLD - Field number of WP field to be calculated
; Output OPT - Total number of characters in all lines of WP field
; concatenated to VALID. ex: 165^1 or 180^0
; VALID - indicates whether invalid characters were detected
N DATA,DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC,VALID
S VALID=1
K ^UTILITY($J,"W")
S DIWL=1,DIWR="",DIWF="|C264",OPT=0
S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
S OPI=0 F S OPI=$O(^OOPS(2260,IEN,OPNODE,OPI)) Q:'OPI S X=$G(^OOPS(2260,IEN,OPNODE,OPI,0)) D:X]"" ^DIWP
I $G(^UTILITY($J,"W",1))+0 D
. S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI D
.. S DATA=^UTILITY($J,"W",1,OPI,0)
.. I DATA'=$TR(DATA,"~`@#$%^*_|\}{[]><","") S VALID=0
.. S OPT=OPT+$L(DATA)
K ^UTILITY($J,"W"),X
Q OPT_U_VALID
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSUTL4 9785 printed Dec 13, 2024@01:39:48 Page 2
OOPSUTL4 ;HINES/WAA-Utilities Routines ;3/24/98
+1 ;;2.0;ASISTS;**7,15**;Jun 03, 2002;Build 9
DTVAL(DATE,FLD1,FLD2) ;
+1 ; this subroutine called from ^DD so date error checking on fields
+2 ; 143, 144, 145 (if CA1) and 254, 255 (if CA2). returns a valid date
+3 ; (one passed in) if a date in FLD2 and is > than date passed in (DATE).
+4 ; Inputs: DATE - date entered in prompt
+5 ; FLD1 - field of prompt date entered in
+6 ; FLD2 - field of date to be checked against
+7 ; Outputs: VAL - contains valid date passed in if true & "" if false
+8 NEW DTE2,VAL
+9 SET VAL=DATE
SET DTE2=""
+10 IF '$GET(IEN)
SET IEN=$GET(DA)
+11 IF IEN
SET DTE2=$$GET1^DIQ(2260,IEN,FLD2,"I")
+12 IF %DT'["R"
SET DTE2=DTE2\1
+13 IF DTE2>DATE!'$GET(DTE2)
SET VAL=""
+14 IF 'VAL
Begin DoDot:1
+15 ;V2_P15 changed direct writes with call to EN^DDIOL
+16 IF '$GET(DTE2)
DO EN^DDIOL($$GET1^DID(2260,FLD2,"","LABEL")_" cannot be blank if date entered in "_$$GET1^DID(2260,FLD1,"","LABEL"),"","!!!?5")
+17 DO EN^DDIOL($$GET1^DID(2260,FLD1,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,FLD2,"","LABEL"),"","!!!?5")
End DoDot:1
+18 QUIT VAL
VALIDATE(IEN,FORM,CALLER,VALID) ;
+1 ; Input: IEN = Internal Entry Number of entry in file 2260
+2 ; FORM = 2162,CA1, or CA2
+3 ; CALLER = "E" employee
+4 ; = "S" supervisor
+5 ; = "O" safety officer
+6 ; = "W" worker's comp personnel
+7 ; WCEMP = from menu if 1 - need to execute emp validation
+8 ; VALID = RESERVED FOR OUTPUT DATA
+9 ; Output:VALID = 1 ALL REQUIRED DATA FOR FORM IS COMPLETE
+10 ; = 0 DATA IS MISSING
+11 NEW LIST,FLD,CNT,CHK
+12 SET (FLD,LIST)=""
+13 SET VALID=1
SET CHK=0
SET WCEMP=$GET(WCEMP,0)
+14 WRITE !,"Validating data on form ",FORM,"."
+15 IF CALLER="E"!$GET(WCEMP)
DO EMP
+16 IF CALLER="S"
DO SUP
+17 IF CALLER="O"
DO SOF
+18 IF CALLER="W"
DO WCP
+19 FOR CNT=1:1
SET FLD=$PIECE(LIST,",",CNT)
if FLD=""
QUIT
Begin DoDot:1
+20 NEW LOC,NODE,PCE,BADFLD,TEXT,WP
+21 SET BADFLD=1
SET WP=0
+22 SET LOC=$$GET1^DID(2260,FLD,"","GLOBAL SUBSCRIPT LOCATION")
+23 SET NODE=$PIECE(LOC,";")
SET PCE=$PIECE(LOC,";",2)
+24 ;Work processing field
IF PCE=0
Begin DoDot:2
+25 IF '$DATA(^OOPS(2260,IEN,NODE,1,0))
SET (BADFLD,VALID)=0
+26 SET WP=1
+27 QUIT
End DoDot:2
+28 IF PCE'=0
IF $PIECE($GET(^OOPS(2260,IEN,NODE)),U,PCE)=""
SET (BADFLD,VALID)=0
+29 ; Display error messaged about fields not filled.
IF 'BADFLD
Begin DoDot:2
+30 IF 'CHK
WRITE !!,"The following fields must be completed before the "_FORM_" can be signed.",!
SET CHK=1
+31 ;Is this a wp field and where to get title
IF WP
Begin DoDot:3
+32 NEW NODE
+33 SET NODE=2260_".0"_FLD
+34 ; patch 11 - fix bug on fld 40, node '= 2260.040, it's 2260.01
+35 IF FLD=40
SET NODE="2260.01"
+36 SET TEXT=$$GET1^DID(NODE,".01","","TITLE")
End DoDot:3
+37 IF 'WP
SET TEXT=$$GET1^DID(2260,FLD,"","TITLE")
IF $GET(TEXT)=""
SET TEXT=$$GET1^DID(2260,FLD,"","LABEL")
+38 ; patch 2.7 - if body part affected - indicate the form
+39 IF FLD=30
IF (TEXT'="")
SET TEXT=TEXT_" (FORM 2162)"
+40 WRITE !,TEXT
End DoDot:2
End DoDot:1
+41 ; fld 110 check on Emp CA1 only
IF FORM="CA1"&(CALLER="E"!$GET(WCEMP))
Begin DoDot:1
+42 IF $$GET1^DIQ(2260,IEN,110,"I")<($$GET1^DIQ(2260,IEN,4,"I")\1)
SET VALID=0
Begin DoDot:2
+43 WRITE !?5,$$GET1^DID(2260,110,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,4,"","LABEL")
End DoDot:2
End DoDot:1
DTCHK ; Date error checking that may be missed w/input transform
+1 ; patch 11 - Additional error checking has been added for CA2 field 214
+2 IF FORM=2162!(CALLER="O")!$GET(WCEMP)
QUIT
+3 KILL CNT,FLD,LIST
+4 NEW DATE,DTE1,DTE2,TITLE,EMPDOB
+5 ; patch 11 - need to make sure 215 not before 214 on employee part
+6 IF CALLER="E"
IF FORM="CA2"
Begin DoDot:1
+7 SET DTE1=$$GET1^DIQ(2260,IEN,215,"I")
+8 SET DTE2=$$GET1^DIQ(2260,IEN,214,"I")
+9 SET EMPDOB=$$GET1^DIQ(2260,IEN,6,"I")
+10 IF $$FMDIFF^XLFDT(DTE2,EMPDOB,2)<0
SET VALID=0
Begin DoDot:2
+11 WRITE !?5,$$GET1^DID(2260,214,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,6,"","LABEL")
End DoDot:2
+12 IF $$FMDIFF^XLFDT(DTE1,DTE2,2)<0
SET VALID=0
Begin DoDot:2
+13 WRITE !?5,$$GET1^DID(2260,215,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,214,"","LABEL")
End DoDot:2
End DoDot:1
QUIT
+14 ; End of checks from Employee CA2
+15 IF FORM="CA1"
Begin DoDot:1
+16 SET LIST="142,161,175"
+17 SET (DATE,DTE1)=$$GET1^DIQ(2260,IEN,4,"I")
+18 SET TITLE=$$GET1^DID(2260,4,"","LABEL")
End DoDot:1
+19 IF FORM="CA2"
Begin DoDot:1
+20 SET LIST="215,250,252,253,255"
+21 SET (DATE,DTE1)=$$GET1^DIQ(2260,IEN,214,"I")
+22 SET TITLE=$$GET1^DID(2260,214,"","LABEL")
End DoDot:1
+23 FOR CNT=1:1
SET FLD=$PIECE(LIST,",",CNT)
if FLD=""
QUIT
Begin DoDot:1
+24 SET DTE2=$$GET1^DIQ(2260,IEN,FLD,"I")
IF FLD'=142
SET DTE2=DTE2\1
SET DTE1=DATE\1
+25 IF $GET(DTE2)
IF DTE2<DTE1
Begin DoDot:2
+26 WRITE !?5,$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE
End DoDot:2
SET VALID=0
End DoDot:1
+27 ; Need specific check on DATE/TIME STOPPED WORK
+28 IF FORM="CA1"
Begin DoDot:1
+29 SET LIST="143,144,145"
SET DATE=$$GET1^DIQ(2260,IEN,142,"I")
+30 SET TITLE=$$GET1^DID(2260,142,"","LABEL")
End DoDot:1
+31 IF FORM="CA2"
Begin DoDot:1
+32 SET LIST="254,256"
SET DATE=$$GET1^DIQ(2260,IEN,253,"I")
+33 SET TITLE=$$GET1^DID(2260,253,"","LABEL")
End DoDot:1
+34 FOR CNT=1:1
SET FLD=$PIECE(LIST,",",CNT)
if FLD=""
QUIT
Begin DoDot:1
+35 SET DTE2=$$GET1^DIQ(2260,IEN,FLD,"I")
SET DTE1=DATE
Begin DoDot:2
+36 IF FLD=143!(FLD=144)
SET DTE1=DATE\1
SET DTE2=DTE2\1
+37 IF (DTE1>DTE2)
IF $GET(DTE2)
Begin DoDot:3
+38 WRITE !?5,$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE
End DoDot:3
SET VALID=0
+39 IF '$GET(DTE1)
IF $GET(DTE2)
Begin DoDot:3
+40 WRITE !?5,TITLE_" cannot be blank if date in "_$$GET1^DID(2260,FLD,"","LABEL")
End DoDot:3
SET VALID=0
End DoDot:2
End DoDot:1
+41 QUIT
EMP ; Address fields are now all pulled from the 2162A node
+1 ; added fields 126 & 181,183-185 to lists below - patch 8
+2 IF FORM="CA1"
SET LIST="8,9,10,11,12,108,109,110,111,112,113,114,126,181,183,184,185"
+3 ; added field 213 - ASISTS V2.0
+4 IF FORM="CA2"
SET LIST="8,9,10,11,12,126,208,213,209,214,215,216,217"
+5 QUIT
SUP ;
+1 NEW F165
+2 IF FORM="2162"
DO F2162
IF $$ISEMP^OOPSUTL4(IEN)
SET LIST=LIST_",33"
QUIT
+3 SET LIST="30,"
+4 IF FORM="CA1"
Begin DoDot:1
+5 SET LIST=LIST_"4,60,130,131,132,133,134,138,139,140,146,148,150,"
+6 SET LIST=LIST_"162,163,172,173,174,175,176,177,178,179,"
+7 SET LIST=LIST_"180,181,183,184,185,"
+8 IF $$GET1^DIQ(2260,IEN,150,"I")="Y"
SET LIST=LIST_"151,152,153,154,155,"
+9 ; V2.0 added required fields missed in patch 8
+10 IF $$GET1^DIQ(2260,IEN,146)="No"
SET LIST=LIST_"147,"
+11 IF $$GET1^DIQ(2260,IEN,148)="Yes"
SET LIST=LIST_"149,"
+12 IF $$GET1^DIQ(2260,IEN,163)="No"
SET LIST=LIST_"164,"
+13 SET F165=$GET(^OOPS(2260,IEN,"CA1K",0))
+14 IF $GET(F165)'=""
IF ($PIECE(F165,U,4)'=0)
SET LIST=LIST_"165,"
End DoDot:1
+15 IF FORM="CA2"
Begin DoDot:1
+16 SET LIST=LIST_"230,231,232,233,234,237,238,239,240,241,"
+17 SET LIST=LIST_"242,243,244,251,252,255,258,60,268,269,"
+18 ; below for ASISTS V2.0, needed for roll and scroll also
+19 ; added next line, need to get 3rd party if 258 = y
+20 IF $$GET1^DIQ(2260,IEN,258,"I")="Y"
SET LIST=LIST_"259,260,261,262,263,"
End DoDot:1
+21 ; V2.0 if field 60="other" (3) then 61 required for both CA1 & CA2
+22 IF $$GET1^DIQ(2260,IEN,60,"I")=3
SET LIST=LIST_"61,"
+23 ; need to check physician information
+24 DO PHYCHK^OOPSGUI9
+25 QUIT
SOF ;
+1 IF FORM="2162"
DO F2162
SET LIST=LIST_",55,47"
+2 QUIT
WCP ; Get required fields for Workers Comp
+1 IF FORM="2162"
DO F2162
QUIT
+2 SET LIST="5,6,7,15,62,70,73,"
+3 IF FORM="CA1"
Begin DoDot:1
+4 SET LIST=LIST_"123,124,"
+5 ; flds 166 & 167 only required if personnel status = 1
+6 IF $$GET1^DIQ(2260,IEN,2,"I")=1
SET LIST=LIST_"166,167,"
End DoDot:1
+7 IF FORM="CA2"
Begin DoDot:1
+8 SET LIST=LIST_"226,227,"
End DoDot:1
+9 DO SUP
+10 QUIT
F2162 ; Set required fields for form 2162 - doesn't matter which menu
+1 ; coming from, Supervisor, Safety, WC (for EDIT REPORT OF INCIDENT)
+2 NEW TYP,SAF
+3 IF FORM'="2162"
QUIT
+4 SET LIST="26,27,28,29,30,31"
+5 SET TYP=$$GET1^DIQ(2260,IEN,"3:.01","E")
+6 IF "^Sharps Exposure^Hollow Bore Needlestick^Suture Needlestick^"[TYP
Begin DoDot:1
+7 SET LIST=LIST_",34,35,36,37,38,82"
End DoDot:1
+8 IF $$GET1^DIQ(2260,IEN,"38:2","I")="N"
SET LIST=LIST_",83"
+9 IF "^Exposure to Body Fluids/Splash^"[TYP
Begin DoDot:1
+10 SET LIST=LIST_",34,39,40,41"
End DoDot:1
+11 IF $$GET1^DIQ(2260,IEN,3,"I")<11
QUIT
+12 IF $$GET1^DIQ(2260,IEN,42.5,"I")="Y"
SET LIST=LIST_",42"
+13 SET SAF=$$GET1^DIQ(2260,IEN,43,"I")
+14 SET LIST=$SELECT(SAF="Y":LIST_",84,87",SAF="N":LIST_",85",1:LIST)
+15 SET LIST=LIST_",47"
+16 QUIT
UP(IN) ; Translate all lower to upper
+1 NEW OUT
+2 SET OUT=$TRANSLATE(IN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+3 QUIT OUT
VCHAR(IN) ; Check to make sure no invalid characters have been used
+1 ; input - IN, data entered by user
+2 ; output - VALID, if invalid characters used, = 0
+3 NEW VALID
+4 SET VALID=1
+5 IF IN'=$TRANSLATE(IN,"~`@#$%*_|\}{[]><","")
SET VALID=0
+6 QUIT VALID
ISEMP(IEN) ; Determine if PERSONNEL STATUS = employee
+1 ; Input - IEN = internal Entry Number of case in File 2260
+2 ; CAT = Personnel Status of Case in File 2260
+3 ; TST = valid Personnel status categories for employee
+4 ; Output - EMP = 1 Personnel status indicates employee
+5 ; 0 Personnel status indicates non-employee
+6 NEW CAT,TST,EMP
+7 SET EMP=0
+8 SET CAT=$$GET1^DIQ(2260,IEN,2,"I")
+9 ; 12/16/01 V2.0 removed personnel types 7,8,9,10
+10 SET TST=",1,2,6,"
+11 IF TST[(","_CAT_",")
SET EMP=1
+12 QUIT EMP
FUT(DATE) ; Check for dates prior to Date of Inj/Ill
+1 NEW DAT,VIEW,FORM
+2 SET VIEW=1
+3 SET FORM=$$GET1^DIQ(2260,IEN,52,"I")
+4 SET DAT=$$GET1^DIQ(2260,IEN,4,"I")
+5 IF (DATE<$PIECE(DAT,"."))
IF FORM=1
Begin DoDot:1
+6 WRITE !!?6,"This date cannot be prior to DATE/TIME INJURY OCCURRED entered on 2162.",!
SET VIEW=0
End DoDot:1
+7 QUIT VIEW
WP(OPFLD) ; Patch 8 - determine number of characters in WP fields that are
+1 ; limited to 532 characters & if invalid characters are present
+2 ; Input IEN - Internal Record ID of Case
+3 ; OPFLD - Field number of WP field to be calculated
+4 ; Output OPT - Total number of characters in all lines of WP field
+5 ; concatenated to VALID. ex: 165^1 or 180^0
+6 ; VALID - indicates whether invalid characters were detected
+7 NEW DATA,DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC,VALID
+8 SET VALID=1
+9 KILL ^UTILITY($JOB,"W")
+10 SET DIWL=1
SET DIWR=""
SET DIWF="|C264"
SET OPT=0
+11 SET OPNODE=$PIECE($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
+12 SET OPI=0
FOR
SET OPI=$ORDER(^OOPS(2260,IEN,OPNODE,OPI))
if 'OPI
QUIT
SET X=$GET(^OOPS(2260,IEN,OPNODE,OPI,0))
if X]""
DO ^DIWP
+13 IF $GET(^UTILITY($JOB,"W",1))+0
Begin DoDot:1
+14 SET OPI=0
FOR OPC=1:1
SET OPI=$ORDER(^UTILITY($JOB,"W",1,OPI))
if 'OPI
QUIT
Begin DoDot:2
+15 SET DATA=^UTILITY($JOB,"W",1,OPI,0)
+16 IF DATA'=$TRANSLATE(DATA,"~`@#$%^*_|\}{[]><","")
SET VALID=0
+17 SET OPT=OPT+$LENGTH(DATA)
End DoDot:2
End DoDot:1
+18 KILL ^UTILITY($JOB,"W"),X
+19 QUIT OPT_U_VALID
