- 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 Jan 18, 2025@02:41:02 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