OOPSGUIT ;WIOFO/LLH-RPC Rtn for Type of Incident rpt ;11/5/01
;;2.0;ASISTS;**4,7,11,15**;Jun 03, 2002;Build 9
;
ENT(RESULTS,TRPT,CSTAT,STDT,ENDDT,LTNTT,STAT,PSTAT) ;
N DATA,CNT,CS,CS1,EDATE,OOPS,LOST,LP,SDATE,TOT,RPTTY
N STATION,LOSTTIME,NODE,OOPDA,PER,X,Y
S RPTTY=$$REPORT(),CS=$S(CSTAT="O":0,CSTAT="C":1,1:"")
S LOST=$S(LTNTT="L":"Y",1:""),(SDATE,EDATE)=""
S X=STDT D ^%DT S SDATE=Y,X=ENDDT D ^%DT S EDATE=Y
S SDATE=(SDATE-1)_".9999",EDATE=EDATE_".9999",LP="",OOPDA=""
F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE) D
.F S OOPDA=$O(^OOPS(2260,"AD",LP,OOPDA)) Q:OOPDA'>0 D
..S OOPS(0)=$G(^OOPS(2260,OOPDA,0))
..S CS1=$P(OOPS(0),U,6)
..I $G(CS1)>1 Q ; only open & closed cases
..I (CS'=""),(CS'=CS1) Q ; if 'All cases, case status must match
..S PER=$$GET1^DIQ(2260,OOPDA,2,"I")
..I (+PSTAT)&(PSTAT'[(PER_"^")) Q
..S STATION=$$GET1^DIQ(2260,OOPDA,13,"I")
..I STAT'="A",(STATION'=STAT) Q
..S LOSTTIME=""
..I $O(^OOPS(2260,OOPDA,"OUTC","AC","A","A","")) S LOSTTIME="Y"
..I LOST="Y",(LOSTTIME'="Y") Q
..I RPTTY=3 D
...N INC S INC=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
...I $G(INC)="" S INC="Unknown"
...S:$D(DATA(INC))=0 DATA(INC)=0 S DATA(INC)=DATA(INC)+1
..I RPTTY=15 D
...N DIC,DR,DA,DIQ,FLD,NAME,OCC,IEN450,X,Y
...S NAME=$$GET1^DIQ(2260,OOPDA,1),FLD=16
...S DIC="^PRSPC(",DIC(0)="Z",X=NAME D ^DIC
...I Y>0 D
....K DIQ S DR=FLD,DA=+Y,IEN450=+Y,DIQ="OOPS",DIQ(0)="IE"
....D EN^DIQ1 K DIQ
...S OCC=$$GET1^DIQ(2260,OOPDA,15,"I")
...I $G(IEN450),$G(OCC)'="",(OCC=$E($G(OOPS(450,IEN450,FLD,"I")),1,4)) D
....S OCC=OCC_" - "_OOPS(450,IEN450,FLD,"E")
...I $G(OCC)="" S OCC="Unknown"
...S:$D(DATA(OCC))=0 DATA(OCC)=0 S DATA(OCC)=DATA(OCC)+1
..I RPTTY=29 D
...N CHAR S CHAR=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
...I $G(CHAR)="" S CHAR="Unknown"
...S:$D(DATA(CHAR))=0 DATA(CHAR)=0 S DATA(CHAR)=DATA(CHAR)+1
..I RPTTY=86 D
...N SERV S SERV=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
...I $G(SERV)="" S SERV="Unknown"
...S:$D(DATA(SERV))=0 DATA(SERV)=0 S DATA(SERV)=DATA(SERV)+1
..I RPTTY=30 D
...N BODY S BODY=$$GET1^DIQ(2260,OOPDA,RPTTY_":1")
...F I=1:1 Q:$P($T(BODY+I),";",3)="Q" I $P($T(BODY+I),";",4)[(U_BODY_U) S BODY=$P($T(BODY+I),";",3) Q
...I $G(BODY)="" S BODY="Unknown"
...S:$D(DATA(BODY))=0 DATA(BODY)=0 S DATA(BODY)=DATA(BODY)+1
..I RPTTY=999 D
...N DOI,DOW
...S DOI=$$GET1^DIQ(2260,OOPDA,4,"I"),DOW=$$DOW^XLFDT(DOI)
...S DOW=$S(DOW="Friday":"6Friday",DOW="Monday":"2Monday",DOW="Saturday":"7Saturday",DOW="Sunday":"1Sunday",DOW="Thursday":"5Thursday",DOW="Tuesday":"3Tuesday",DOW="Wednesday":"4Wednesday",1:"Unk")
...I $G(DOI)="" S DOI="Unknown"
...S:$D(DATA(DOW))=0 DATA(DOW)=0 S DATA(DOW)=DATA(DOW)+1
..I RPTTY=9999 D
...N LABEL,TDOI,TIME S TDOI=$P($$GET1^DIQ(2260,OOPDA,4),"@",2)
...I $G(TDOI)="" S TDOI="Unknown"
...I TDOI'="Unknown" D
....I +$P(TDOI,":")&($P(TDOI,":")'=24) S TIME=$P(TDOI,":")
....E S TIME=24
....S LABEL=TIME_":"_"00 - "_TIME_":59"
...I TDOI="Unknown" S LABEL="Unknown"
...S:$D(DATA(LABEL))=0 DATA(LABEL)=0 S DATA(LABEL)=DATA(LABEL)+1
S TOT=1,NODE="",CNT=0
F S NODE=$O(DATA(NODE)) Q:NODE="" S RESULTS(TOT)=NODE_"^"_DATA(NODE),CNT=CNT+$P(RESULTS(TOT),U,2),TOT=TOT+1
I CNT S RESULTS(0)=CNT
Q
REPORT() ; Get Fld # to sort on
I TRPT="Type of Incidents" S RPTTY=3
I TRPT="Occupation Code" S RPTTY=15
I TRPT="Characterization of Injury" S RPTTY=29
I TRPT="Service" S RPTTY=86
I TRPT="Body Parts" S RPTTY=30
I TRPT="Day of Week" S RPTTY=999
I TRPT="Time of Day" S RPTTY=9999
Q RPTTY
BODY ; group the body parts to min # of columns
;;Abdomen;^BA^V5^VI^V4^V3^VL^VM^VS^
;;Arm(s) Lower;^AS^AB^A4^A6^A3^A5^
;;Arm(s) Upper;^AX^AZ^A2^A1^
;;Back (Lumbar Region);^BL^
;;Back (Upper);^BU^
;;Chest;^BC^RS^
;;Ear(s);^H4^C2^H3^C1^
;;Elbow;^EB^ES^
;;Eye(s);^H2^C4^H1^C3^
;;Face;^CK^HC^HF^CJ^HM^CM^HN^CN^CD^CT^
;;Foot,Includes Toes;^PB^G2^G3^G4^PS^G1^
;;Hand(s),Includes fingers;^F2^F8^MB^F4^F6^TB^FB^FS^F1^F7^MS^F3^F5^TS^
;;Knees;^KB^KS^
;;Leg(s), lower;^L4^L3^
;;Leg(s), upper;^LX^LZ^
;;Neck;^HK^CL^CR^
;;Not Elsewhere Classified;^XZ^L2^LB^BZ^XX^VN^RP^LS^L1^
;;Reproductive Organs;^B2^B4^BP^VR^B1^B3^B5^
;;Ribs;^RB^RC^
;;Shoulder;^R2^R4^SB^R1^R3^SS^
;;Skull/Head;^CB^HX^HZ^CX^CZ^HS^CC^CS^
;;Spinal Cord;^VC^RV^
;;Thorax;^VH^V2^V1^
;;Trunk;^BS^RZ^BX^VX^VZ^RX^BW^
;;Q
Q
ACCID(RESULTS,INPUT,CALL) ; Print Accident Report Status report - get data
; Input: INPUT - START,END DATE, & STATION. Format is STARTDATE^
; ENDDATE^STA^CASESTATUS. STA is A or IEN of station,
; case status = open 'O', closed 'C', or both 'A'.
; CALL - calling menu. Excludes name if called from Union menu
; Output: - RESULTS contains the data to be displayed in the report
N ARR,CN,IEN,SDATE,SIGN,SIGSTR,STDT,STA,ENDDT,EDATE,X,Y,SUPSTR,EMPSTR
N CASE,CAT,DOI,EMP,INC,ISEMP,PERSON,SAF,SSN,SSN1,SP,SUP,WCP,PCE
; patch 4 llh - select by case status ; patch 11, get super's name
N CS,STATUS,SUPER,S48,S6,S20,S12
S S48=" "
S S6=" ",S12=" ",S20=" "
K ^TMP($J,"ACCID")
S CN=1,RESULTS(0)="Processing..."
S STDT=$P($G(INPUT),U),ENDDT=$P($G(INPUT),U,2)
S STA=$P($G(INPUT),U,3),STATUS=$P($G(INPUT),U,4)
I (STDT="")!(ENDDT="")!(STA="")!(STATUS="") D Q
.S RESULTS(0)="Input parameters missing, cannot run report." Q
S STATUS=$S(STATUS="O":0,STATUS="C":1,1:"")
S (SDATE,EDATE)=""
S X=STDT D ^%DT S SDATE=Y
S X=ENDDT D ^%DT S EDATE=Y
S SDATE=(SDATE-1)_".9999",EDATE=EDATE_".9999"
S SSN="" I CALL="Employee" S SSN=$$GET1^DIQ(200,DUZ,9)
S LP="",IEN=""
F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE) D
.F S IEN=$O(^OOPS(2260,"AD",LP,IEN)) Q:IEN'>0 D
..S CS=$$GET1^DIQ(2260,IEN,51,"I")
..I $G(CS)>1 Q ; exclude deleted, amended cases
..I (STATUS'=""),(CS'=STATUS) Q ; if 'All cases, status must match
..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9)
..I $G(STA)'="A",STATION'=STA Q
..I (CALL="Supervisor"),($$GET1^DIQ(2260,IEN,53,"I")'=DUZ&($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ)) Q
..S (ARR,CASE,PERSON,SSN1,DOI,INC,CAT,WCP,EMP,SUP,SUPER,SAF,SP)=""
..S CASE=$$GET1^DIQ(2260,IEN,.01),SUPER=$$GET1^DIQ(2260,IEN,53)
..S (PERSON,SSN1)=""
..;V2_P15 - changed the SSN display for privacy act concerns
..I CALL'="Union" S PERSON=$E($$GET1^DIQ(2260,IEN,1),1,30),SSN1="xxx-xx-"_$E($$GET1^DIQ(2260,IEN,5),8,12)
..S INC=$$GET1^DIQ(2260,IEN,52,"I"),DOI=$$GET1^DIQ(2260,IEN,4)
..S CAT=$$GET1^DIQ(2260,IEN,2,"I")
..; patch 4 llh - get case status title
..S CS=$S(CS=0:"Open",CS=1:"Closed",1:"") I SSN1="" S SSN1=" "
..S ARR=" ",^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..S ARR="Case Number Name SSN Case Status Date/Time of Incident"
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..S PERSON=PERSON_" ",PERSON=$E(PERSON,1,37)
..I $L(CASE)=10 S CASE=CASE_" "
..;patch 4 llh - pad case status title if needed for alignment
..I $L(CS)=4 S CS=CS_" "
..S ARR=CASE_" "_PERSON_SSN1_" "_CS_" "_DOI
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..I CALL="Employee" Q:SSN'=SSN1
..S ISEMP=$$ISEMP^OOPSUTL4(IEN)
..I 'ISEMP S ISEMP="N/A("_$E($$GET1^DIQ(2260,IEN,2,"E"),1,10)_")"
..S SIGN="",SIGSTR="^^^^^^"
..S SIGN=$P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC)
..S $P(SIGSTR,U,INC)=$S('SIGN:"Un-Signed",SIGN:"Signed",1:"")
..I 'ISEMP S $P(SIGSTR,U,INC)=ISEMP
..S (SIGN,PCE,SUPSTR)=""
..S SIGN=$$EDSTA^OOPSUTL1(IEN,"S"),PCE=INC+2
..I ISEMP S $P(SIGSTR,U,PCE)=$S('$P(SIGN,U,INC):"Un-Signed",$P(SIGN,U,INC):"Signed",1:"")
..S $P(SIGSTR,U,5)=$S($P(SIGN,U,3):"Signed",1:"Un-Signed")
..S SIGN="",SIGN=$$EDSTA^OOPSUTL1(IEN,"O")
..S $P(SIGSTR,U,6)=$S($P(SIGN,U):"Signed",1:"Un-Signed")
..S SIGN="",SIGN=$$GET1^DIQ(2260,IEN,68)
..S $P(SIGSTR,U,7)=$S((($P(SIGN,U)="")&ISEMP):"Un-Signed",($P(SIGN,U)'=""):"Signed",1:"")
..F I=1:1:7 I $P(SIGSTR,U,I)="Signed" D
...I I=1 S $P(SIGSTR,U,1)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,121,"I")),"2DZ")
...I I=2 S $P(SIGSTR,U,2)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,223,"I")),"2DZ")
...I I=3 S $P(SIGSTR,U,3)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,171,"I")),"2DZ")_" "
...I I=4 S $P(SIGSTR,U,4)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,267,"I")),"2DZ")_" "
...I I=5 S $P(SIGSTR,U,5)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,46,"I")),"2DZ")
...I I=6 S $P(SIGSTR,U,6)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,50,"I")),"2DZ")
...I I=7 S $P(SIGSTR,U,7)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,69,"I")),"2DZ")
..S ARR=S48_" "_"CA1"_S12_"CA2"_S12_"2162"_S12_"WCP"
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..S ARR=S48_" "_"---"_S12_"---"_S12_"----"_S12_"---"
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..S EMPSTR=S20_S20_" Employee: "
..I INC=1 S ARR=EMPSTR_$P(SIGSTR,U,1)
..I INC=2 S ARR=EMPSTR_S12_" "_$P(SIGSTR,U,2)
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..; patch 11 - add supervisors name
..I $G(SUPER)'="" S SUPSTR=SUPER_", Supervisor: " F I=1:1:58 Q:$L(SUPSTR)>57 S SUPSTR=" "_SUPSTR
..E S SUPSTR=S20_S20_" Supervisor: "
..I 'ISEMP S SUPSTR=SUPSTR_" "
..I INC=1 D
...I $P(SIGSTR,U,3)="Signed" S ARR=SUPSTR_$P(SIGSTR,U,3)_S6_S12_$P(SIGSTR,U,5)
...E S ARR=SUPSTR_$P(SIGSTR,U,3)_S20_" "_$P(SIGSTR,U,5)
..I INC=2 D
...I $P(SIGSTR,U,4)="Signed" S ARR=SUPSTR_S12_" "_$P(SIGSTR,U,4)_" "_$P(SIGSTR,U,5)
...E S ARR=SUPSTR_S12_" "_$P(SIGSTR,U,4)_S6_$P(SIGSTR,U,5)
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..S ARR=S20_S12_" Safety Officer:"_S20_S12_" "_$P(SIGSTR,U,6)
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
..S ARR=S20_S12_" Workers' Comp:"_S48_" "_$P(SIGSTR,U,7)
..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
S RESULTS=$NA(^TMP($J,"ACCID"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSGUIT 9894 printed Dec 13, 2024@01:39:13 Page 2
OOPSGUIT ;WIOFO/LLH-RPC Rtn for Type of Incident rpt ;11/5/01
+1 ;;2.0;ASISTS;**4,7,11,15**;Jun 03, 2002;Build 9
+2 ;
ENT(RESULTS,TRPT,CSTAT,STDT,ENDDT,LTNTT,STAT,PSTAT) ;
+1 NEW DATA,CNT,CS,CS1,EDATE,OOPS,LOST,LP,SDATE,TOT,RPTTY
+2 NEW STATION,LOSTTIME,NODE,OOPDA,PER,X,Y
+3 SET RPTTY=$$REPORT()
SET CS=$SELECT(CSTAT="O":0,CSTAT="C":1,1:"")
+4 SET LOST=$SELECT(LTNTT="L":"Y",1:"")
SET (SDATE,EDATE)=""
+5 SET X=STDT
DO ^%DT
SET SDATE=Y
SET X=ENDDT
DO ^%DT
SET EDATE=Y
+6 SET SDATE=(SDATE-1)_".9999"
SET EDATE=EDATE_".9999"
SET LP=""
SET OOPDA=""
+7 FOR LP=SDATE:0
SET LP=$ORDER(^OOPS(2260,"AD",LP))
if (LP'>0)!(LP>EDATE)
QUIT
Begin DoDot:1
+8 FOR
SET OOPDA=$ORDER(^OOPS(2260,"AD",LP,OOPDA))
if OOPDA'>0
QUIT
Begin DoDot:2
+9 SET OOPS(0)=$GET(^OOPS(2260,OOPDA,0))
+10 SET CS1=$PIECE(OOPS(0),U,6)
+11 ; only open & closed cases
IF $GET(CS1)>1
QUIT
+12 ; if 'All cases, case status must match
IF (CS'="")
IF (CS'=CS1)
QUIT
+13 SET PER=$$GET1^DIQ(2260,OOPDA,2,"I")
+14 IF (+PSTAT)&(PSTAT'[(PER_"^"))
QUIT
+15 SET STATION=$$GET1^DIQ(2260,OOPDA,13,"I")
+16 IF STAT'="A"
IF (STATION'=STAT)
QUIT
+17 SET LOSTTIME=""
+18 IF $ORDER(^OOPS(2260,OOPDA,"OUTC","AC","A","A",""))
SET LOSTTIME="Y"
+19 IF LOST="Y"
IF (LOSTTIME'="Y")
QUIT
+20 IF RPTTY=3
Begin DoDot:3
+21 NEW INC
SET INC=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
+22 IF $GET(INC)=""
SET INC="Unknown"
+23 if $DATA(DATA(INC))=0
SET DATA(INC)=0
SET DATA(INC)=DATA(INC)+1
End DoDot:3
+24 IF RPTTY=15
Begin DoDot:3
+25 NEW DIC,DR,DA,DIQ,FLD,NAME,OCC,IEN450,X,Y
+26 SET NAME=$$GET1^DIQ(2260,OOPDA,1)
SET FLD=16
+27 SET DIC="^PRSPC("
SET DIC(0)="Z"
SET X=NAME
DO ^DIC
+28 IF Y>0
Begin DoDot:4
+29 KILL DIQ
SET DR=FLD
SET DA=+Y
SET IEN450=+Y
SET DIQ="OOPS"
SET DIQ(0)="IE"
+30 DO EN^DIQ1
KILL DIQ
End DoDot:4
+31 SET OCC=$$GET1^DIQ(2260,OOPDA,15,"I")
+32 IF $GET(IEN450)
IF $GET(OCC)'=""
IF (OCC=$EXTRACT($GET(OOPS(450,IEN450,FLD,"I")),1,4))
Begin DoDot:4
+33 SET OCC=OCC_" - "_OOPS(450,IEN450,FLD,"E")
End DoDot:4
+34 IF $GET(OCC)=""
SET OCC="Unknown"
+35 if $DATA(DATA(OCC))=0
SET DATA(OCC)=0
SET DATA(OCC)=DATA(OCC)+1
End DoDot:3
+36 IF RPTTY=29
Begin DoDot:3
+37 NEW CHAR
SET CHAR=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
+38 IF $GET(CHAR)=""
SET CHAR="Unknown"
+39 if $DATA(DATA(CHAR))=0
SET DATA(CHAR)=0
SET DATA(CHAR)=DATA(CHAR)+1
End DoDot:3
+40 IF RPTTY=86
Begin DoDot:3
+41 NEW SERV
SET SERV=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
+42 IF $GET(SERV)=""
SET SERV="Unknown"
+43 if $DATA(DATA(SERV))=0
SET DATA(SERV)=0
SET DATA(SERV)=DATA(SERV)+1
End DoDot:3
+44 IF RPTTY=30
Begin DoDot:3
+45 NEW BODY
SET BODY=$$GET1^DIQ(2260,OOPDA,RPTTY_":1")
+46 FOR I=1:1
if $PIECE($TEXT(BODY+I),";",3)="Q"
QUIT
IF $PIECE($TEXT(BODY+I),";",4)[(U_BODY_U)
SET BODY=$PIECE($TEXT(BODY+I),";",3)
QUIT
+47 IF $GET(BODY)=""
SET BODY="Unknown"
+48 if $DATA(DATA(BODY))=0
SET DATA(BODY)=0
SET DATA(BODY)=DATA(BODY)+1
End DoDot:3
+49 IF RPTTY=999
Begin DoDot:3
+50 NEW DOI,DOW
+51 SET DOI=$$GET1^DIQ(2260,OOPDA,4,"I")
SET DOW=$$DOW^XLFDT(DOI)
+52 SET DOW=$SELECT(DOW="Friday":"6Friday",DOW="Monday":"2Monday",DOW="Saturday":"7Saturday",DOW="Sunday":"1Sunday",DOW="Thursday":"5Thursday",DOW="Tuesday":"3Tuesday",DOW="Wednesday":"4Wednesday",1:"Unk")
+53 IF $GET(DOI)=""
SET DOI="Unknown"
+54 if $DATA(DATA(DOW))=0
SET DATA(DOW)=0
SET DATA(DOW)=DATA(DOW)+1
End DoDot:3
+55 IF RPTTY=9999
Begin DoDot:3
+56 NEW LABEL,TDOI,TIME
SET TDOI=$PIECE($$GET1^DIQ(2260,OOPDA,4),"@",2)
+57 IF $GET(TDOI)=""
SET TDOI="Unknown"
+58 IF TDOI'="Unknown"
Begin DoDot:4
+59 IF +$PIECE(TDOI,":")&($PIECE(TDOI,":")'=24)
SET TIME=$PIECE(TDOI,":")
+60 IF '$TEST
SET TIME=24
+61 SET LABEL=TIME_":"_"00 - "_TIME_":59"
End DoDot:4
+62 IF TDOI="Unknown"
SET LABEL="Unknown"
+63 if $DATA(DATA(LABEL))=0
SET DATA(LABEL)=0
SET DATA(LABEL)=DATA(LABEL)+1
End DoDot:3
End DoDot:2
End DoDot:1
+64 SET TOT=1
SET NODE=""
SET CNT=0
+65 FOR
SET NODE=$ORDER(DATA(NODE))
if NODE=""
QUIT
SET RESULTS(TOT)=NODE_"^"_DATA(NODE)
SET CNT=CNT+$PIECE(RESULTS(TOT),U,2)
SET TOT=TOT+1
+66 IF CNT
SET RESULTS(0)=CNT
+67 QUIT
REPORT() ; Get Fld # to sort on
+1 IF TRPT="Type of Incidents"
SET RPTTY=3
+2 IF TRPT="Occupation Code"
SET RPTTY=15
+3 IF TRPT="Characterization of Injury"
SET RPTTY=29
+4 IF TRPT="Service"
SET RPTTY=86
+5 IF TRPT="Body Parts"
SET RPTTY=30
+6 IF TRPT="Day of Week"
SET RPTTY=999
+7 IF TRPT="Time of Day"
SET RPTTY=9999
+8 QUIT RPTTY
BODY ; group the body parts to min # of columns
+1 ;;Abdomen;^BA^V5^VI^V4^V3^VL^VM^VS^
+2 ;;Arm(s) Lower;^AS^AB^A4^A6^A3^A5^
+3 ;;Arm(s) Upper;^AX^AZ^A2^A1^
+4 ;;Back (Lumbar Region);^BL^
+5 ;;Back (Upper);^BU^
+6 ;;Chest;^BC^RS^
+7 ;;Ear(s);^H4^C2^H3^C1^
+8 ;;Elbow;^EB^ES^
+9 ;;Eye(s);^H2^C4^H1^C3^
+10 ;;Face;^CK^HC^HF^CJ^HM^CM^HN^CN^CD^CT^
+11 ;;Foot,Includes Toes;^PB^G2^G3^G4^PS^G1^
+12 ;;Hand(s),Includes fingers;^F2^F8^MB^F4^F6^TB^FB^FS^F1^F7^MS^F3^F5^TS^
+13 ;;Knees;^KB^KS^
+14 ;;Leg(s), lower;^L4^L3^
+15 ;;Leg(s), upper;^LX^LZ^
+16 ;;Neck;^HK^CL^CR^
+17 ;;Not Elsewhere Classified;^XZ^L2^LB^BZ^XX^VN^RP^LS^L1^
+18 ;;Reproductive Organs;^B2^B4^BP^VR^B1^B3^B5^
+19 ;;Ribs;^RB^RC^
+20 ;;Shoulder;^R2^R4^SB^R1^R3^SS^
+21 ;;Skull/Head;^CB^HX^HZ^CX^CZ^HS^CC^CS^
+22 ;;Spinal Cord;^VC^RV^
+23 ;;Thorax;^VH^V2^V1^
+24 ;;Trunk;^BS^RZ^BX^VX^VZ^RX^BW^
+25 ;;Q
+26 QUIT
ACCID(RESULTS,INPUT,CALL) ; Print Accident Report Status report - get data
+1 ; Input: INPUT - START,END DATE, & STATION. Format is STARTDATE^
+2 ; ENDDATE^STA^CASESTATUS. STA is A or IEN of station,
+3 ; case status = open 'O', closed 'C', or both 'A'.
+4 ; CALL - calling menu. Excludes name if called from Union menu
+5 ; Output: - RESULTS contains the data to be displayed in the report
+6 NEW ARR,CN,IEN,SDATE,SIGN,SIGSTR,STDT,STA,ENDDT,EDATE,X,Y,SUPSTR,EMPSTR
+7 NEW CASE,CAT,DOI,EMP,INC,ISEMP,PERSON,SAF,SSN,SSN1,SP,SUP,WCP,PCE
+8 ; patch 4 llh - select by case status ; patch 11, get super's name
+9 NEW CS,STATUS,SUPER,S48,S6,S20,S12
+10 SET S48=" "
+11 SET S6=" "
SET S12=" "
SET S20=" "
+12 KILL ^TMP($JOB,"ACCID")
+13 SET CN=1
SET RESULTS(0)="Processing..."
+14 SET STDT=$PIECE($GET(INPUT),U)
SET ENDDT=$PIECE($GET(INPUT),U,2)
+15 SET STA=$PIECE($GET(INPUT),U,3)
SET STATUS=$PIECE($GET(INPUT),U,4)
+16 IF (STDT="")!(ENDDT="")!(STA="")!(STATUS="")
Begin DoDot:1
+17 SET RESULTS(0)="Input parameters missing, cannot run report."
QUIT
End DoDot:1
QUIT
+18 SET STATUS=$SELECT(STATUS="O":0,STATUS="C":1,1:"")
+19 SET (SDATE,EDATE)=""
+20 SET X=STDT
DO ^%DT
SET SDATE=Y
+21 SET X=ENDDT
DO ^%DT
SET EDATE=Y
+22 SET SDATE=(SDATE-1)_".9999"
SET EDATE=EDATE_".9999"
+23 SET SSN=""
IF CALL="Employee"
SET SSN=$$GET1^DIQ(200,DUZ,9)
+24 SET LP=""
SET IEN=""
+25 FOR LP=SDATE:0
SET LP=$ORDER(^OOPS(2260,"AD",LP))
if (LP'>0)!(LP>EDATE)
QUIT
Begin DoDot:1
+26 FOR
SET IEN=$ORDER(^OOPS(2260,"AD",LP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+27 SET CS=$$GET1^DIQ(2260,IEN,51,"I")
+28 ; exclude deleted, amended cases
IF $GET(CS)>1
QUIT
+29 ; if 'All cases, status must match
IF (STATUS'="")
IF (CS'=STATUS)
QUIT
+30 SET STATION=$PIECE(^OOPS(2260,IEN,"2162A"),U,9)
+31 IF $GET(STA)'="A"
IF STATION'=STA
QUIT
+32 IF (CALL="Supervisor")
IF ($$GET1^DIQ(2260,IEN,53,"I")'=DUZ&($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ))
QUIT
+33 SET (ARR,CASE,PERSON,SSN1,DOI,INC,CAT,WCP,EMP,SUP,SUPER,SAF,SP)=""
+34 SET CASE=$$GET1^DIQ(2260,IEN,.01)
SET SUPER=$$GET1^DIQ(2260,IEN,53)
+35 SET (PERSON,SSN1)=""
+36 ;V2_P15 - changed the SSN display for privacy act concerns
+37 IF CALL'="Union"
SET PERSON=$EXTRACT($$GET1^DIQ(2260,IEN,1),1,30)
SET SSN1="xxx-xx-"_$EXTRACT($$GET1^DIQ(2260,IEN,5),8,12)
+38 SET INC=$$GET1^DIQ(2260,IEN,52,"I")
SET DOI=$$GET1^DIQ(2260,IEN,4)
+39 SET CAT=$$GET1^DIQ(2260,IEN,2,"I")
+40 ; patch 4 llh - get case status title
+41 SET CS=$SELECT(CS=0:"Open",CS=1:"Closed",1:"")
IF SSN1=""
SET SSN1=" "
+42 SET ARR=" "
SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+43 SET ARR="Case Number Name SSN Case Status Date/Time of Incident"
+44 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+45 SET PERSON=PERSON_" "
SET PERSON=$EXTRACT(PERSON,1,37)
+46 IF $LENGTH(CASE)=10
SET CASE=CASE_" "
+47 ;patch 4 llh - pad case status title if needed for alignment
+48 IF $LENGTH(CS)=4
SET CS=CS_" "
+49 SET ARR=CASE_" "_PERSON_SSN1_" "_CS_" "_DOI
+50 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+51 IF CALL="Employee"
if SSN'=SSN1
QUIT
+52 SET ISEMP=$$ISEMP^OOPSUTL4(IEN)
+53 IF 'ISEMP
SET ISEMP="N/A("_$EXTRACT($$GET1^DIQ(2260,IEN,2,"E"),1,10)_")"
+54 SET SIGN=""
SET SIGSTR="^^^^^^"
+55 SET SIGN=$PIECE($$EDSTA^OOPSUTL1(IEN,"E"),U,INC)
+56 SET $PIECE(SIGSTR,U,INC)=$SELECT('SIGN:"Un-Signed",SIGN:"Signed",1:"")
+57 IF 'ISEMP
SET $PIECE(SIGSTR,U,INC)=ISEMP
+58 SET (SIGN,PCE,SUPSTR)=""
+59 SET SIGN=$$EDSTA^OOPSUTL1(IEN,"S")
SET PCE=INC+2
+60 IF ISEMP
SET $PIECE(SIGSTR,U,PCE)=$SELECT('$PIECE(SIGN,U,INC):"Un-Signed",$PIECE(SIGN,U,INC):"Signed",1:"")
+61 SET $PIECE(SIGSTR,U,5)=$SELECT($PIECE(SIGN,U,3):"Signed",1:"Un-Signed")
+62 SET SIGN=""
SET SIGN=$$EDSTA^OOPSUTL1(IEN,"O")
+63 SET $PIECE(SIGSTR,U,6)=$SELECT($PIECE(SIGN,U):"Signed",1:"Un-Signed")
+64 SET SIGN=""
SET SIGN=$$GET1^DIQ(2260,IEN,68)
+65 SET $PIECE(SIGSTR,U,7)=$SELECT((($PIECE(SIGN,U)="")&ISEMP):"Un-Signed",($PIECE(SIGN,U)'=""):"Signed",1:"")
+66 FOR I=1:1:7
IF $PIECE(SIGSTR,U,I)="Signed"
Begin DoDot:3
+67 IF I=1
SET $PIECE(SIGSTR,U,1)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,121,"I")),"2DZ")
+68 IF I=2
SET $PIECE(SIGSTR,U,2)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,223,"I")),"2DZ")
+69 IF I=3
SET $PIECE(SIGSTR,U,3)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,171,"I")),"2DZ")_" "
+70 IF I=4
SET $PIECE(SIGSTR,U,4)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,267,"I")),"2DZ")_" "
+71 IF I=5
SET $PIECE(SIGSTR,U,5)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,46,"I")),"2DZ")
+72 IF I=6
SET $PIECE(SIGSTR,U,6)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,50,"I")),"2DZ")
+73 IF I=7
SET $PIECE(SIGSTR,U,7)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,69,"I")),"2DZ")
End DoDot:3
+74 SET ARR=S48_" "_"CA1"_S12_"CA2"_S12_"2162"_S12_"WCP"
+75 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+76 SET ARR=S48_" "_"---"_S12_"---"_S12_"----"_S12_"---"
+77 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+78 SET EMPSTR=S20_S20_" Employee: "
+79 IF INC=1
SET ARR=EMPSTR_$PIECE(SIGSTR,U,1)
+80 IF INC=2
SET ARR=EMPSTR_S12_" "_$PIECE(SIGSTR,U,2)
+81 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+82 ; patch 11 - add supervisors name
+83 IF $GET(SUPER)'=""
SET SUPSTR=SUPER_", Supervisor: "
FOR I=1:1:58
if $LENGTH(SUPSTR)>57
QUIT
SET SUPSTR=" "_SUPSTR
+84 IF '$TEST
SET SUPSTR=S20_S20_" Supervisor: "
+85 IF 'ISEMP
SET SUPSTR=SUPSTR_" "
+86 IF INC=1
Begin DoDot:3
+87 IF $PIECE(SIGSTR,U,3)="Signed"
SET ARR=SUPSTR_$PIECE(SIGSTR,U,3)_S6_S12_$PIECE(SIGSTR,U,5)
+88 IF '$TEST
SET ARR=SUPSTR_$PIECE(SIGSTR,U,3)_S20_" "_$PIECE(SIGSTR,U,5)
End DoDot:3
+89 IF INC=2
Begin DoDot:3
+90 IF $PIECE(SIGSTR,U,4)="Signed"
SET ARR=SUPSTR_S12_" "_$PIECE(SIGSTR,U,4)_" "_$PIECE(SIGSTR,U,5)
+91 IF '$TEST
SET ARR=SUPSTR_S12_" "_$PIECE(SIGSTR,U,4)_S6_$PIECE(SIGSTR,U,5)
End DoDot:3
+92 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+93 SET ARR=S20_S12_" Safety Officer:"_S20_S12_" "_$PIECE(SIGSTR,U,6)
+94 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
+95 SET ARR=S20_S12_" Workers' Comp:"_S48_" "_$PIECE(SIGSTR,U,7)
+96 SET ^TMP($JOB,"ACCID",CN)=ARR
SET CN=CN+1
SET ARR=""
End DoDot:2
End DoDot:1
+97 SET RESULTS=$NAME(^TMP($JOB,"ACCID"))
+98 QUIT
