- OOPSGUI9 ;WIOFO/LLH-RPC routines ;10/24/01
- ;;2.0;ASISTS;**6,7**;Jun 03, 2002
- ;;
- 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,CN,CNT,CHK
- S (FLD,LIST)=""
- S VALID=1,CHK=0
- S CN=2 ; start CN in RESULTS array after index 1
- ; removed code in line below that would also do set if the variable
- ; WCEMP set. WCEMP was an indicator that WC was completing CA1 for
- ; employee. May need to do something else. 10/24/01 llh
- I CALLER="E" 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,";")
- .S 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 S RESULTS(1)="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","","LABEL")
- ...Q
- ..I 'WP S TEXT=$$GET1^DID(2260,FLD,"","LABEL")
- ..; patch 2.7 if it's body part most affected, indicate the source form
- ..I FLD=30 S TEXT=$G(TEXT)_" (FORM 2162)"
- ..S RESULTS(CN)=TEXT,CN=CN+1
- ..Q
- .Q
- ; removed !($G(WCEMP)) which indicates validation coming from WC
- ; completing the employee portion of the CA1. May need to figure
- ; something else out. 10/24/01 llh
- I FORM="CA1"&(CALLER="E") 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
- .. S RESULTS(CN)=$$GET1^DID(2260,110,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,4,"","LABEL"),CN=CN+1
- DTCHK ; Date error checking that may be missed w/input transform
- ; patch 11 - Additional error checking has been added for CA2 field 214
- ; removed $G(WCEMP) from line below. same concern as above 10/24/01 llh
- I FORM=2162!(CALLER="O") Q
- K CNT,FLD,LIST
- N DATE,DATE1,DATE2,TITLE,EMPDOB
- ; patch 11 - need to make sure 215 not before 214 on employee part
- I CALLER="E",FORM="CA2" D Q
- . S DATE1=$$GET1^DIQ(2260,IEN,215,"I")
- . S DATE2=$$GET1^DIQ(2260,IEN,214,"I")
- . S EMPDOB=$$GET1^DIQ(2260,IEN,6,"I")
- . I $$FMDIFF^XLFDT(DATE2,EMPDOB,2)<0 S VALID=0 D
- .. S RESULTS(CN)=$$GET1^DID(2260,214,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,6,"","LABEL"),CN=CN+1
- . I $$FMDIFF^XLFDT(DATE1,DATE2,2)<0 S VALID=0 D
- .. S RESULTS(CN)=$$GET1^DID(2260,215,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,214,"","LABEL"),CN=CN+1
- ; End of checks from Employee CA2
- I FORM="CA1" D
- . S LIST="142,161,175"
- . S (DATE,DATE1)=$$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,DATE1)=$$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 DATE2=$$GET1^DIQ(2260,IEN,FLD,"I") I FLD'=142 S DATE2=DATE2\1,DATE1=DATE\1
- . I $G(DATE2),DATE2<DATE1 D S VALID=0
- .. S RESULTS(CN)=$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE,CN=CN+1
- ; 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 DATE2=$$GET1^DIQ(2260,IEN,FLD,"I"),DATE1=DATE D
- .. I FLD=143!(FLD=144) S DATE1=DATE\1,DATE2=DATE2\1
- .. I (DATE1>DATE2),$G(DATE2) D S VALID=0
- ... S RESULTS(CN)=$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE,CN=CN+1
- .. I '$G(DATE1),$G(DATE2) D S VALID=0
- ... S RESULTS(CN)=TITLE_" cannot be blank if date in "_$$GET1^DID(2260,FLD,"","LABEL"),CN=CN+1
- 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,209,213,214,215,216,217"
- Q
- SUP ;
- N F165
- I FORM="2162" D F2162 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 for both CA1 and CA2
- D PHYCHK
- Q
- PHYCHK ; checks physician fields for appropriate form. If Phy Name not
- ; blank address fields required. If Phy Name blank and data in any
- ; address field then all fields required.
- N CTR,FLD,PHY,PLIST,NBLK
- S NBLK="",PHY=$S(FORM="CA1":156,FORM="CA2":245,1:"")
- I 'PHY Q
- S PLIST=$S(PHY=156:"157,158,159,160,182",PHY=245:"246,247,248,249,270",1:"")
- I PLIST="" Q
- I PHY=156 D Q
- . I $$GET1^DIQ(2260,IEN,156)'="" D Q
- .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)="" S LIST=LIST_FLD_","
- . I $$GET1^DIQ(2260,IEN,156)="" D Q
- .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)'="" S NBLK=NBLK_FLD_","
- .. I $G(NBLK)'="" S LIST=LIST_"156," F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I '$F(NBLK,FLD) S LIST=LIST_FLD_","
- I PHY=245 D Q
- . I $$GET1^DIQ(2260,IEN,245)'="" D Q
- .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)="" S LIST=LIST_FLD_","
- . I $$GET1^DIQ(2260,IEN,245)="" D
- .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)'="" S NBLK=NBLK_FLD_","
- .. I $G(NBLK)'="" S LIST=LIST_"245," F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I '$F(NBLK,FLD) S LIST=LIST_FLD_","
- Q
- SOF ; the call to F2162 here is overkill. All these fields should
- ; already be completed, but just in case...
- ; removed field 89 from required list for patch 7
- I FORM="2162" D F2162 S LIST=LIST_",55,88"
- ; code below obsolete with patch 7
- ;I $$ISEMP^OOPSUTL4(IEN) D
- ;.S LIST=LIST_",33"
- ;.I $$GET1^DIQ(2260,IEN,33)="N" S LIST=LIST_",32"
- 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
- N TYP,SAF,INCID
- 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"
- S INCID=$$GET1^DIQ(2260,IEN,3,"I")
- I (INCID<11)!(INCID>14) 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSGUI9 8551 printed Feb 18, 2025@23:05:30 Page 2
- OOPSGUI9 ;WIOFO/LLH-RPC routines ;10/24/01
- +1 ;;2.0;ASISTS;**6,7**;Jun 03, 2002
- +2 ;;
- 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,CN,CNT,CHK
- +12 SET (FLD,LIST)=""
- +13 SET VALID=1
- SET CHK=0
- +14 ; start CN in RESULTS array after index 1
- SET CN=2
- +15 ; removed code in line below that would also do set if the variable
- +16 ; WCEMP set. WCEMP was an indicator that WC was completing CA1 for
- +17 ; employee. May need to do something else. 10/24/01 llh
- +18 IF CALLER="E"
- DO EMP
- +19 IF CALLER="S"
- DO SUP
- +20 IF CALLER="O"
- DO SOF
- +21 IF CALLER="W"
- DO WCP
- +22 FOR CNT=1:1
- SET FLD=$PIECE(LIST,",",CNT)
- if FLD=""
- QUIT
- Begin DoDot:1
- +23 NEW LOC,NODE,PCE,BADFLD,TEXT,WP
- +24 SET BADFLD=1
- SET WP=0
- +25 SET LOC=$$GET1^DID(2260,FLD,"","GLOBAL SUBSCRIPT LOCATION")
- +26 SET NODE=$PIECE(LOC,";")
- +27 SET PCE=$PIECE(LOC,";",2)
- +28 ;Work processing field
- IF PCE=0
- Begin DoDot:2
- +29 IF '$DATA(^OOPS(2260,IEN,NODE,1,0))
- SET (BADFLD,VALID)=0
- +30 SET WP=1
- +31 QUIT
- End DoDot:2
- +32 IF PCE'=0
- IF $PIECE($GET(^OOPS(2260,IEN,NODE)),U,PCE)=""
- SET (BADFLD,VALID)=0
- +33 ; Display error messaged about fields not filled.
- IF 'BADFLD
- Begin DoDot:2
- +34 IF 'CHK
- SET RESULTS(1)="The following fields must be completed before the "_FORM_" can be signed."
- SET CHK=1
- +35 ;Is this a wp field and where to get title
- IF WP
- Begin DoDot:3
- +36 NEW NODE
- +37 SET NODE=2260_".0"_FLD
- +38 ; patch 11 - fix bug on fld 40, node '= 2260.040, it's 2260.01
- +39 IF FLD=40
- SET NODE="2260.01"
- +40 SET TEXT=$$GET1^DID(NODE,".01","","LABEL")
- +41 QUIT
- End DoDot:3
- +42 IF 'WP
- SET TEXT=$$GET1^DID(2260,FLD,"","LABEL")
- +43 ; patch 2.7 if it's body part most affected, indicate the source form
- +44 IF FLD=30
- SET TEXT=$GET(TEXT)_" (FORM 2162)"
- +45 SET RESULTS(CN)=TEXT
- SET CN=CN+1
- +46 QUIT
- End DoDot:2
- +47 QUIT
- End DoDot:1
- +48 ; removed !($G(WCEMP)) which indicates validation coming from WC
- +49 ; completing the employee portion of the CA1. May need to figure
- +50 ; something else out. 10/24/01 llh
- +51 ; fld 110 check on Emp CA1 only
- IF FORM="CA1"&(CALLER="E")
- Begin DoDot:1
- +52 IF $$GET1^DIQ(2260,IEN,110,"I")<($$GET1^DIQ(2260,IEN,4,"I")\1)
- SET VALID=0
- Begin DoDot:2
- +53 SET RESULTS(CN)=$$GET1^DID(2260,110,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,4,"","LABEL")
- SET CN=CN+1
- 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 ; removed $G(WCEMP) from line below. same concern as above 10/24/01 llh
- +3 IF FORM=2162!(CALLER="O")
- QUIT
- +4 KILL CNT,FLD,LIST
- +5 NEW DATE,DATE1,DATE2,TITLE,EMPDOB
- +6 ; patch 11 - need to make sure 215 not before 214 on employee part
- +7 IF CALLER="E"
- IF FORM="CA2"
- Begin DoDot:1
- +8 SET DATE1=$$GET1^DIQ(2260,IEN,215,"I")
- +9 SET DATE2=$$GET1^DIQ(2260,IEN,214,"I")
- +10 SET EMPDOB=$$GET1^DIQ(2260,IEN,6,"I")
- +11 IF $$FMDIFF^XLFDT(DATE2,EMPDOB,2)<0
- SET VALID=0
- Begin DoDot:2
- +12 SET RESULTS(CN)=$$GET1^DID(2260,214,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,6,"","LABEL")
- SET CN=CN+1
- End DoDot:2
- +13 IF $$FMDIFF^XLFDT(DATE1,DATE2,2)<0
- SET VALID=0
- Begin DoDot:2
- +14 SET RESULTS(CN)=$$GET1^DID(2260,215,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,214,"","LABEL")
- SET CN=CN+1
- End DoDot:2
- End DoDot:1
- QUIT
- +15 ; End of checks from Employee CA2
- +16 IF FORM="CA1"
- Begin DoDot:1
- +17 SET LIST="142,161,175"
- +18 SET (DATE,DATE1)=$$GET1^DIQ(2260,IEN,4,"I")
- +19 SET TITLE=$$GET1^DID(2260,4,"","LABEL")
- End DoDot:1
- +20 IF FORM="CA2"
- Begin DoDot:1
- +21 SET LIST="215,250,252,253,255"
- +22 SET (DATE,DATE1)=$$GET1^DIQ(2260,IEN,214,"I")
- +23 SET TITLE=$$GET1^DID(2260,214,"","LABEL")
- End DoDot:1
- +24 FOR CNT=1:1
- SET FLD=$PIECE(LIST,",",CNT)
- if FLD=""
- QUIT
- Begin DoDot:1
- +25 SET DATE2=$$GET1^DIQ(2260,IEN,FLD,"I")
- IF FLD'=142
- SET DATE2=DATE2\1
- SET DATE1=DATE\1
- +26 IF $GET(DATE2)
- IF DATE2<DATE1
- Begin DoDot:2
- +27 SET RESULTS(CN)=$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE
- SET CN=CN+1
- End DoDot:2
- SET VALID=0
- End DoDot:1
- +28 ; Need specific check on DATE/TIME STOPPED WORK
- +29 IF FORM="CA1"
- Begin DoDot:1
- +30 SET LIST="143,144,145"
- SET DATE=$$GET1^DIQ(2260,IEN,142,"I")
- +31 SET TITLE=$$GET1^DID(2260,142,"","LABEL")
- End DoDot:1
- +32 IF FORM="CA2"
- Begin DoDot:1
- +33 SET LIST="254,256"
- SET DATE=$$GET1^DIQ(2260,IEN,253,"I")
- +34 SET TITLE=$$GET1^DID(2260,253,"","LABEL")
- End DoDot:1
- +35 FOR CNT=1:1
- SET FLD=$PIECE(LIST,",",CNT)
- if FLD=""
- QUIT
- Begin DoDot:1
- +36 SET DATE2=$$GET1^DIQ(2260,IEN,FLD,"I")
- SET DATE1=DATE
- Begin DoDot:2
- +37 IF FLD=143!(FLD=144)
- SET DATE1=DATE\1
- SET DATE2=DATE2\1
- +38 IF (DATE1>DATE2)
- IF $GET(DATE2)
- Begin DoDot:3
- +39 SET RESULTS(CN)=$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE
- SET CN=CN+1
- End DoDot:3
- SET VALID=0
- +40 IF '$GET(DATE1)
- IF $GET(DATE2)
- Begin DoDot:3
- +41 SET RESULTS(CN)=TITLE_" cannot be blank if date in "_$$GET1^DID(2260,FLD,"","LABEL")
- SET CN=CN+1
- End DoDot:3
- SET VALID=0
- End DoDot:2
- End DoDot:1
- +42 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,209,213,214,215,216,217"
- +5 QUIT
- SUP ;
- +1 NEW F165
- +2 IF FORM="2162"
- DO F2162
- 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 for both CA1 and CA2
- +24 DO PHYCHK
- +25 QUIT
- PHYCHK ; checks physician fields for appropriate form. If Phy Name not
- +1 ; blank address fields required. If Phy Name blank and data in any
- +2 ; address field then all fields required.
- +3 NEW CTR,FLD,PHY,PLIST,NBLK
- +4 SET NBLK=""
- SET PHY=$SELECT(FORM="CA1":156,FORM="CA2":245,1:"")
- +5 IF 'PHY
- QUIT
- +6 SET PLIST=$SELECT(PHY=156:"157,158,159,160,182",PHY=245:"246,247,248,249,270",1:"")
- +7 IF PLIST=""
- QUIT
- +8 IF PHY=156
- Begin DoDot:1
- +9 IF $$GET1^DIQ(2260,IEN,156)'=""
- Begin DoDot:2
- +10 FOR CTR=1:1
- SET FLD=$PIECE(PLIST,",",CTR)
- if FLD=""
- QUIT
- IF $$GET1^DIQ(2260,IEN,FLD)=""
- SET LIST=LIST_FLD_","
- End DoDot:2
- QUIT
- +11 IF $$GET1^DIQ(2260,IEN,156)=""
- Begin DoDot:2
- +12 FOR CTR=1:1
- SET FLD=$PIECE(PLIST,",",CTR)
- if FLD=""
- QUIT
- IF $$GET1^DIQ(2260,IEN,FLD)'=""
- SET NBLK=NBLK_FLD_","
- +13 IF $GET(NBLK)'=""
- SET LIST=LIST_"156,"
- FOR CTR=1:1
- SET FLD=$PIECE(PLIST,",",CTR)
- if FLD=""
- QUIT
- IF '$FIND(NBLK,FLD)
- SET LIST=LIST_FLD_","
- End DoDot:2
- QUIT
- End DoDot:1
- QUIT
- +14 IF PHY=245
- Begin DoDot:1
- +15 IF $$GET1^DIQ(2260,IEN,245)'=""
- Begin DoDot:2
- +16 FOR CTR=1:1
- SET FLD=$PIECE(PLIST,",",CTR)
- if FLD=""
- QUIT
- IF $$GET1^DIQ(2260,IEN,FLD)=""
- SET LIST=LIST_FLD_","
- End DoDot:2
- QUIT
- +17 IF $$GET1^DIQ(2260,IEN,245)=""
- Begin DoDot:2
- +18 FOR CTR=1:1
- SET FLD=$PIECE(PLIST,",",CTR)
- if FLD=""
- QUIT
- IF $$GET1^DIQ(2260,IEN,FLD)'=""
- SET NBLK=NBLK_FLD_","
- +19 IF $GET(NBLK)'=""
- SET LIST=LIST_"245,"
- FOR CTR=1:1
- SET FLD=$PIECE(PLIST,",",CTR)
- if FLD=""
- QUIT
- IF '$FIND(NBLK,FLD)
- SET LIST=LIST_FLD_","
- End DoDot:2
- End DoDot:1
- QUIT
- +20 QUIT
- SOF ; the call to F2162 here is overkill. All these fields should
- +1 ; already be completed, but just in case...
- +2 ; removed field 89 from required list for patch 7
- +3 IF FORM="2162"
- DO F2162
- SET LIST=LIST_",55,88"
- +4 ; code below obsolete with patch 7
- +5 ;I $$ISEMP^OOPSUTL4(IEN) D
- +6 ;.S LIST=LIST_",33"
- +7 ;.I $$GET1^DIQ(2260,IEN,33)="N" S LIST=LIST_",32"
- +8 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
- +1 NEW TYP,SAF,INCID
- +2 IF FORM'="2162"
- QUIT
- +3 SET LIST="26,27,28,29,30,31"
- +4 SET TYP=$$GET1^DIQ(2260,IEN,"3:.01","E")
- +5 IF "^Sharps Exposure^Hollow Bore Needlestick^Suture Needlestick^"[TYP
- Begin DoDot:1
- +6 SET LIST=LIST_",34,35,36,37,38,82"
- End DoDot:1
- +7 IF $$GET1^DIQ(2260,IEN,"38:2","I")="N"
- SET LIST=LIST_",83"
- +8 IF "^Exposure to Body Fluids/Splash^"[TYP
- Begin DoDot:1
- +9 SET LIST=LIST_",34,39,40,41"
- End DoDot:1
- +10 SET INCID=$$GET1^DIQ(2260,IEN,3,"I")
- +11 IF (INCID<11)!(INCID>14)
- 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