OOPSGUIR ;WIOFO/LLH-RPC routine for misc reports ; 6/11/09 10:32am
;;2.0;ASISTS;**8,7,11,14,20,25**;Jun 03, 2002;Build 4
;
ENT(RESULTS,INPUT,CALL) ; get the data for the report
; Input: INPUT - contains 3 values, the START AND END DATE,
; STATION. The Date of Occ (fld #4) is used to
; in/exclude claims from the report. If Station='ALL'
; then all claims are included, if not 'All', then
; only 1 station is included.
; CALL - contains the report call which will invoke
; the appropriate M call
; Output: RESULTS - the results array passes data back to the client.
N CAX,FI,LP,MENU,SDATE,STDT,STA,STATION,ENDDT,EDATE,TAG,X,Y,%DT
S RESULTS(0)="Processing..."
S STDT=$P($G(INPUT),U),ENDDT=$P($G(INPUT),U,2)
S STA=$P($G(INPUT),U,3),TAG=CALL
I (STDT="")!(ENDDT="")!(STA="")!(TAG="") D Q
. S RESULTS(0)="Input parameters missing, cannot run report." Q
K ^TMP($J,TAG)
S (SDATE,EDATE,MENU)=""
S X=STDT D ^%DT S SDATE=Y
S X=ENDDT D ^%DT S EDATE=Y
; SDATE made last time in day prior so start date correct
I TAG="LOG300U" S TAG="LOG300",MENU="U"
S SDATE=(SDATE-1)+.9999,EDATE=EDATE_".9999"
D @TAG
Q
SERVICE ; Service/Detail Location report - patch 11
DSPUTE ; Reason for Dispute report. Patch 11
FLD174 ; Report compiles filing instruction result counts
FLD332 ; Use this tag for Reason for Controvert report. Patch 11
N ARR,CODE,CN,LP,IEN,I,GOON,P2,TX
S LP="",IEN="",CN=0
I TAG="FLD174" D
.S CODE=$P($G(^DD(2260,174,0)),U,3)
.F I=1:1 S LP=$P(CODE,";",I) Q:$G(LP)="" I $P(LP,":",2)'="" S ARR(LP)=0
.S ARR(I_":No Data Entered")=0
I TAG="FLD332" D
.F I=1:1 Q:'$D(^OOPS(2262.4,I)) S ARR(I_":"_$P(^OOPS(2262.4,I,0),U))=0
.S ARR(98_":Blk 36 also has text entered")=0
.S ARR(99_":Controvert question checked Yes, but no Controvert Code entered")=0
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
..I $$GET1^DIQ(2260,IEN,51,"I")>1 Q ;only allow open/closed cases
..S CAX=$$GET1^DIQ(2260,IEN,52,"I")
..I TAG'="SERVICE"&(CAX=2) Q ;only allow CA1's
..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9)
..I ($G(STA)'="A"),(STATION'=STA) Q ;get correct station
..;patch 11 - sent to OOPSGUIF due to size this routine
..I TAG="DSPUTE" D DSPUTE^OOPSGUIF
..I TAG="SERVICE" D SERVICE^OOPSGUIU
..; Filing instructions report
..I TAG="FLD174" D
...S FI=$$GET1^DIQ(2260,IEN,174,"I")_":"_$$GET1^DIQ(2260,IEN,174)
...I $$GET1^DIQ(2260,IEN,174)="" S FI=I_":No Data Entered"
...S ARR(FI)=ARR(FI)+1
...;patch 11 - Reason for controvert report
..I TAG="FLD332" D
...;first Agency Controvert must = "Y" to be counted
...S GOON=$$GET1^DIQ(2260,IEN,165.1,"I") I $G(GOON)'="Y" D Q
....S:'$D(ARR("999:Case not controverted, no controvert code expected")) ARR("999:Case not controverted, no controvert code expected")=0
....S ARR("999:Case not controverted, no controvert code expected")=ARR("999:Case not controverted, no controvert code expected")+1
...S FI=$$GET1^DIQ(2260,IEN,332,"I")_":"_$$GET1^DIQ(2260,IEN,332)
...I $$GET1^DIQ(2260,IEN,332)="" S FI=99_":Controvert question checked Yes, but no Controvert Code entered"
...S ARR(FI)=ARR(FI)+1
...I $G(^OOPS(2260,IEN,"CA1K",1,0))'="" D
....;if case is diputed, don't count in Controvert rpt - quit
....S GOON=$$GET1^DIQ(2260,IEN,165.2,"I") I $G(GOON)="Y" Q
....S ARR(98_":Blk 36 also has text entered")=ARR(98_":Blk 36 also has text entered")+1
I TAG'="DSPUTE",(TAG'="SERVICE") D
.S CN=0,FI="",P2=""
.F S FI=$O(ARR(FI)) Q:FI="" D
..S CN=$P(FI,":"),P2=$P(FI,":",2),CODE=0
..I TAG="FLD332" S TX=$O(^OOPS(2262.4,"B",P2,"")) I $G(TX) S CODE=$P(^OOPS(2262.4,TX,0),U,2)
..S ^TMP($J,TAG,CN)=P2_U_CODE_U_ARR(FI)
..; rearrange 'bogus' Controvert Codes for report formating
..I TAG="FLD332",(CN>97) S ^TMP($J,TAG,CN)=U_P2_U_ARR(FI)
I TAG="SERVICE" D CMPLSRV^OOPSGUIU
I TAG="DSPUTE" D DSPUTE^OOPSGUIU
S RESULTS=$NA(^TMP($J,TAG))
Q
SUM300A ; Summary of Work-related injuries and illness report
N CN,EMP,FAC,HRS,STATE,STR
N COLG,COLH,COLI,COLJ,COLK,COLL,COLM
S (COLG,COLH,COLI,COLJ,COLK,COLL)=0
S (COLM(1),COLM(2),COLM(3),COLM(4),COLM(5),COLM(6))=0
S ^TMP($J,TAG,0)="No worksheet data for this station."
S FAC=$$GET1^DIQ(4,STA,.01,"E")
K ARR D STATINFO^OOPSGUI3(.ARR,STA) I $D(ARR) D
.S STATE=$P($G(ARR(0)),U,3)
.I $G(STATE)'="" D
..S STATE=$O(^DIC(5,"B",STATE,""))
..S $P(ARR(0),U,3)=$P(^DIC(5,STATE,0),U,2)
.S ^TMP($J,TAG,0)=FAC_U_ARR(0)
K ARR D SITEPGET^OOPSGUI6(.ARR,"OSHA300") I $D(ARR) D
.S CN=0 F S CN=$O(ARR(CN)) Q:CN="" D
..I $P(ARR(CN),U,11)'=STA Q
..S STR=$P($P(ARR(CN),U,1)," = ",2)
..S STR=$P(ARR(CN),U,3)_U_$P(ARR(CN),U,4)_U_$P(ARR(CN),U,6)_U
..S STR=STR_$P(ARR(CN),U,7)_U_$P(ARR(CN),U,8)
..S ^TMP($J,TAG,0)=^TMP($J,TAG,0)_U_STR
K ARR,DATA S DATA=""
D EMPHRS,DETAIL
Q
IRWSHT ; Incidence Rates Worksheet Report
N COLHI,EMP,HRS
S ^TMP($J,TAG,1)="No Worksheet Data for this Station"
S COLHI=0
K ARR,DATA S DATA=""
D EMPHRS,DETAIL
Q
DETAIL ; now get employee information
LOG300 ; entry point for the OSHA 300 LOG
N CN,CASES,COLF,DOI,FLD,IEN,INC,STATION,TYPE
S DOI=SDATE,CASES=0,CN=1
F S DOI=$O(^OOPS(2260,"AF",DOI)) Q:(DOI>EDATE)!(DOI="") S IEN=0 D
.F S IEN=$O(^OOPS(2260,"AF",DOI,"Y",IEN)) Q:IEN="" D
..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9) I $G(STATION)'=STA Q
..I $P(^OOPS(2260,IEN,0),U,6)>1 Q
..S CASES=CASES+1
..I TAG="IRWSHT" D
...I $D(^OOPS(2260,IEN,"OUTC","AC","A","J"))!$D(^OOPS(2260,IEN,"OUTC","AC","A","A")) S COLHI=COLHI+1
..I TAG="SUM300A" D FLD95
..I TAG="LOG300" D FLD95 D
...S ARR(1)=$$GET1^DIQ(2260,IEN,.01),ARR(2)=$$GET1^DIQ(2260,IEN,1)
...I $$GET1^DIQ(2260,IEN,337,"I")="Y" S ARR(2)="Privacy Case"
...S TYPE=$$GET1^DIQ(2260,IEN,3,"I")
...I TYPE>10&(TYPE<15) S ARR(2)="Privacy Case"
...I MENU="U" S ARR(2)=""
...S INC=$$GET1^DIQ(2260,IEN,52,"I"),FLD=$S(INC=1:111,INC=2:208,1:"")
...S ARR(3)=$$GET1^DIQ(2260,IEN,FLD)
...S ARR(4)=$P($$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,4,"I")),2),"@")
...S ARR(5)=$$GET1^DIQ(2260,IEN,27,"E")
...;v2_P20 changed field to populate ARR(6) - Coluum F OSHA 300 log
...S COLF=$$GET1^DIQ(2260,IEN,384),ARR(6)=COLF
...I (SDATE<3081231.9999&(EDATE>3081231.9999)) S ARR(6)=COLF
...I EDATE<3090101&(COLF="") S ARR(6)=$$GET1^DIQ(2260,IEN,3)_";"_$$GET1^DIQ(2260,IEN,30)
...S DATA=ARR(1)_U_ARR(2)_U_ARR(3)_U_ARR(4)_U_ARR(5)_U_ARR(6)_U_ARR(7)_U
...S DATA=DATA_ARR(8)_U_ARR(9)_U_ARR(10)
...S ^TMP($J,TAG,CN)=DATA,CN=CN+1
I TAG="IRWSHT" S ^TMP($J,TAG,1)=CASES_U_COLHI_U_HRS
I TAG="SUM300A" D
.S DATA=CASES_U_EMP_U_HRS_U_COLG_U_COLH_U_COLI_U_COLJ_U_COLK_U_COLL_U
.S DATA=DATA_COLM(1)_U_COLM(2)_U_COLM(3)_U_COLM(4)_U_COLM(5)_U_COLM(6)
.S ^TMP($J,TAG,1)=DATA
S RESULTS=$NA(^TMP($J,TAG))
K ARR,DATA
Q
FLD95 ; use OUTC subrecord to retrieve data
N AVAIL,ED,SD,S0,INC,ILL,DAYA,DAYJ,DAYS,IEN95,OC,OUTC,S95,TDAY
S S0=$G(^OOPS(2260,IEN,0)),INC=$P(S0,U,7)
S ILL=$P($G(^OOPS(2260,IEN,"2162B")),U,15)
S TDAY=$$HTFM^XLFDT(+$H)
; add days away & job transfer up only to 180 for log, 4 300A get all
S (DAYA,DAYJ,TAWAY)=0,IEN95=0
F S IEN95=$O(^OOPS(2260,IEN,"OUTC",IEN95)) Q:IEN95'>0 D
.S S95=$G(^OOPS(2260,IEN,"OUTC",IEN95,0))
.S SD=$P(S95,U,1),ED=$P(S95,U,2),OC=$P(S95,U,3),DAYS=0
.I $P(S95,U,11)="D" Q ; entry is deleted
.;patch 11 - added logic that if TAG=LOG300 include all incident days
.; up to 180, else 300A, only include date range incidents
.I (TAG="SUM300A"),(EDATE<SD) Q
.I $G(OC)'="" S OUTC(OC)=""
.I TAG="SUM300A" D
..I $G(ED)=""!($G(ED)>EDATE) S DAYS=$$FMDIFF^XLFDT(EDATE,SD,1)+1
.I TAG="LOG300",($G(ED)="") S DAYS=$$FMDIFF^XLFDT(TDAY,SD,1)+1
.I '$G(DAYS) S DAYS=$S(OC="A":$P(S95,U,4),OC="J":$P(S95,U,5),1:0)
.I DAYA+DAYJ>179 Q
.S AVAIL=0
.I DAYS>179 S AVAIL=(180-(DAYA+DAYJ))
.I (DAYS<180) D
..;rra oops*25 - INC809171 account for exactly 180 days
..I (DAYS+DAYA+DAYJ)<=180 S AVAIL=DAYS
..I (DAYS+DAYA+DAYJ)>180 S AVAIL=(180-(DAYA+DAYJ))
.I $G(OC)="A" S DAYA=DAYA+AVAIL
.I $G(OC)="J" S DAYJ=DAYJ+AVAIL
I TAG="SUM300A" D
.S:$G(INC)=1 COLM(1)=COLM(1)+1
.I INC=2 D
..I $G(ILL) S COLM(ILL)=COLM(ILL)+1
..I '$G(ILL) S COLM(6)=COLM(6)+1
.S COLK=COLK+DAYA,COLL=COLL+DAYJ
.I $D(OUTC("D")) S COLG=COLG+1 Q
.I $D(OUTC("A")) S COLH=COLH+1 Q
.I $D(OUTC("J")) S COLI=COLI+1 Q
.I $D(OUTC("O")) S COLJ=COLJ+1 Q
I TAG="LOG300" D
.S ARR(7)="",ARR(10)="",(ARR(8),ARR(9))=0
.I INC=1 S ARR(10)=1
.I INC=2 S:$G(ILL) ARR(10)=ILL S:'$G(ILL) ARR(10)=6
.S ARR(8)=DAYA,ARR(9)=DAYJ
.I $D(OUTC("D")) S ARR(7)="D" S (ARR(8),ARR(9))=0 Q
.I $D(OUTC("A")) S ARR(7)="A" Q
.I $D(OUTC("J")) S ARR(7)="J" Q
.I $D(OUTC("O")) S ARR(7)="O" Q
Q
EMPHRS ; get Total Num Employees and Hours worked
N CASES,ED,LV1,LV2,MON,OK,PAR,SD,SIEN,STR,WS,X,X1,X2
S (EMP,HRS,WS)=0
S PAR="^OOPS(2262,0)",PAR=$Q(@PAR),PAR=$Q(@PAR)
S LV1=$P(PAR,",",2),LV2=$P(PAR,",",3)
S SIEN=$O(^OOPS(2262,LV1,LV2,"B",STA,-1)) Q:SIEN=""
; get month range to make sure all emp numbers and hours are entered
S SDATE=SDATE\1
S SD=$E(SDATE,1,5)_"00"_$E(SDATE,8,$L(SDATE))
S ED=$E(EDATE,1,5)_"00"_$E(EDATE,8,$L(EDATE))
S X1=$E(ED,1,3),X2=$E(SD,1,3)
I X1>X2 D
.S OK=0,X=(X1-X2) S:X>1 OK=(X-1)*12
.S OK=OK+((12-$E(SD,4,5))+1)+$E(ED,4,5)
I X1=X2 S OK=($E(ED,4,5)-$E(SD,4,5))+1
S MON=OK
F S WS=$O(^OOPS(2262,LV1,LV2,SIEN,2,WS)) Q:(WS'>0) D
.S STR=^OOPS(2262,LV1,LV2,SIEN,2,WS,0)
.I ($P(STR,U)'<SD)&($P(STR,U)'>ED) D
..I ($P(STR,U,2)="")!($P(STR,U,3)="") Q
..S EMP=EMP+$P(STR,U,2),HRS=HRS+$P(STR,U,3),OK=OK-1
I '$G(OK) S EMP=EMP/MON
I $G(OK) S (EMP,HRS)="INCOMPLETE DATA"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSGUIR 9799 printed Oct 16, 2024@17:40:02 Page 2
OOPSGUIR ;WIOFO/LLH-RPC routine for misc reports ; 6/11/09 10:32am
+1 ;;2.0;ASISTS;**8,7,11,14,20,25**;Jun 03, 2002;Build 4
+2 ;
ENT(RESULTS,INPUT,CALL) ; get the data for the report
+1 ; Input: INPUT - contains 3 values, the START AND END DATE,
+2 ; STATION. The Date of Occ (fld #4) is used to
+3 ; in/exclude claims from the report. If Station='ALL'
+4 ; then all claims are included, if not 'All', then
+5 ; only 1 station is included.
+6 ; CALL - contains the report call which will invoke
+7 ; the appropriate M call
+8 ; Output: RESULTS - the results array passes data back to the client.
+9 NEW CAX,FI,LP,MENU,SDATE,STDT,STA,STATION,ENDDT,EDATE,TAG,X,Y,%DT
+10 SET RESULTS(0)="Processing..."
+11 SET STDT=$PIECE($GET(INPUT),U)
SET ENDDT=$PIECE($GET(INPUT),U,2)
+12 SET STA=$PIECE($GET(INPUT),U,3)
SET TAG=CALL
+13 IF (STDT="")!(ENDDT="")!(STA="")!(TAG="")
Begin DoDot:1
+14 SET RESULTS(0)="Input parameters missing, cannot run report."
QUIT
End DoDot:1
QUIT
+15 KILL ^TMP($JOB,TAG)
+16 SET (SDATE,EDATE,MENU)=""
+17 SET X=STDT
DO ^%DT
SET SDATE=Y
+18 SET X=ENDDT
DO ^%DT
SET EDATE=Y
+19 ; SDATE made last time in day prior so start date correct
+20 IF TAG="LOG300U"
SET TAG="LOG300"
SET MENU="U"
+21 SET SDATE=(SDATE-1)+.9999
SET EDATE=EDATE_".9999"
+22 DO @TAG
+23 QUIT
SERVICE ; Service/Detail Location report - patch 11
DSPUTE ; Reason for Dispute report. Patch 11
FLD174 ; Report compiles filing instruction result counts
FLD332 ; Use this tag for Reason for Controvert report. Patch 11
+1 NEW ARR,CODE,CN,LP,IEN,I,GOON,P2,TX
+2 SET LP=""
SET IEN=""
SET CN=0
+3 IF TAG="FLD174"
Begin DoDot:1
+4 SET CODE=$PIECE($GET(^DD(2260,174,0)),U,3)
+5 FOR I=1:1
SET LP=$PIECE(CODE,";",I)
if $GET(LP)=""
QUIT
IF $PIECE(LP,":",2)'=""
SET ARR(LP)=0
+6 SET ARR(I_":No Data Entered")=0
End DoDot:1
+7 IF TAG="FLD332"
Begin DoDot:1
+8 FOR I=1:1
if '$DATA(^OOPS(2262.4,I))
QUIT
SET ARR(I_":"_$PIECE(^OOPS(2262.4,I,0),U))=0
+9 SET ARR(98_":Blk 36 also has text entered")=0
+10 SET ARR(99_":Controvert question checked Yes, but no Controvert Code entered")=0
End DoDot:1
+11 FOR LP=SDATE:0
SET LP=$ORDER(^OOPS(2260,"AD",LP))
if (LP'>0)!(LP>EDATE)
QUIT
Begin DoDot:1
+12 FOR
SET IEN=$ORDER(^OOPS(2260,"AD",LP,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+13 ;only allow open/closed cases
IF $$GET1^DIQ(2260,IEN,51,"I")>1
QUIT
+14 SET CAX=$$GET1^DIQ(2260,IEN,52,"I")
+15 ;only allow CA1's
IF TAG'="SERVICE"&(CAX=2)
QUIT
+16 SET STATION=$PIECE(^OOPS(2260,IEN,"2162A"),U,9)
+17 ;get correct station
IF ($GET(STA)'="A")
IF (STATION'=STA)
QUIT
+18 ;patch 11 - sent to OOPSGUIF due to size this routine
+19 IF TAG="DSPUTE"
DO DSPUTE^OOPSGUIF
+20 IF TAG="SERVICE"
DO SERVICE^OOPSGUIU
+21 ; Filing instructions report
+22 IF TAG="FLD174"
Begin DoDot:3
+23 SET FI=$$GET1^DIQ(2260,IEN,174,"I")_":"_$$GET1^DIQ(2260,IEN,174)
+24 IF $$GET1^DIQ(2260,IEN,174)=""
SET FI=I_":No Data Entered"
+25 SET ARR(FI)=ARR(FI)+1
+26 ;patch 11 - Reason for controvert report
End DoDot:3
+27 IF TAG="FLD332"
Begin DoDot:3
+28 ;first Agency Controvert must = "Y" to be counted
+29 SET GOON=$$GET1^DIQ(2260,IEN,165.1,"I")
IF $GET(GOON)'="Y"
Begin DoDot:4
+30 if '$DATA(ARR("999
SET ARR("999:Case not controverted, no controvert code expected")=0
+31 SET ARR("999:Case not controverted, no controvert code expected")=ARR("999:Case not controverted, no controvert code expected")+1
End DoDot:4
QUIT
+32 SET FI=$$GET1^DIQ(2260,IEN,332,"I")_":"_$$GET1^DIQ(2260,IEN,332)
+33 IF $$GET1^DIQ(2260,IEN,332)=""
SET FI=99_":Controvert question checked Yes, but no Controvert Code entered"
+34 SET ARR(FI)=ARR(FI)+1
+35 IF $GET(^OOPS(2260,IEN,"CA1K",1,0))'=""
Begin DoDot:4
+36 ;if case is diputed, don't count in Controvert rpt - quit
+37 SET GOON=$$GET1^DIQ(2260,IEN,165.2,"I")
IF $GET(GOON)="Y"
QUIT
+38 SET ARR(98_":Blk 36 also has text entered")=ARR(98_":Blk 36 also has text entered")+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 IF TAG'="DSPUTE"
IF (TAG'="SERVICE")
Begin DoDot:1
+40 SET CN=0
SET FI=""
SET P2=""
+41 FOR
SET FI=$ORDER(ARR(FI))
if FI=""
QUIT
Begin DoDot:2
+42 SET CN=$PIECE(FI,":")
SET P2=$PIECE(FI,":",2)
SET CODE=0
+43 IF TAG="FLD332"
SET TX=$ORDER(^OOPS(2262.4,"B",P2,""))
IF $GET(TX)
SET CODE=$PIECE(^OOPS(2262.4,TX,0),U,2)
+44 SET ^TMP($JOB,TAG,CN)=P2_U_CODE_U_ARR(FI)
+45 ; rearrange 'bogus' Controvert Codes for report formating
+46 IF TAG="FLD332"
IF (CN>97)
SET ^TMP($JOB,TAG,CN)=U_P2_U_ARR(FI)
End DoDot:2
End DoDot:1
+47 IF TAG="SERVICE"
DO CMPLSRV^OOPSGUIU
+48 IF TAG="DSPUTE"
DO DSPUTE^OOPSGUIU
+49 SET RESULTS=$NAME(^TMP($JOB,TAG))
+50 QUIT
SUM300A ; Summary of Work-related injuries and illness report
+1 NEW CN,EMP,FAC,HRS,STATE,STR
+2 NEW COLG,COLH,COLI,COLJ,COLK,COLL,COLM
+3 SET (COLG,COLH,COLI,COLJ,COLK,COLL)=0
+4 SET (COLM(1),COLM(2),COLM(3),COLM(4),COLM(5),COLM(6))=0
+5 SET ^TMP($JOB,TAG,0)="No worksheet data for this station."
+6 SET FAC=$$GET1^DIQ(4,STA,.01,"E")
+7 KILL ARR
DO STATINFO^OOPSGUI3(.ARR,STA)
IF $DATA(ARR)
Begin DoDot:1
+8 SET STATE=$PIECE($GET(ARR(0)),U,3)
+9 IF $GET(STATE)'=""
Begin DoDot:2
+10 SET STATE=$ORDER(^DIC(5,"B",STATE,""))
+11 SET $PIECE(ARR(0),U,3)=$PIECE(^DIC(5,STATE,0),U,2)
End DoDot:2
+12 SET ^TMP($JOB,TAG,0)=FAC_U_ARR(0)
End DoDot:1
+13 KILL ARR
DO SITEPGET^OOPSGUI6(.ARR,"OSHA300")
IF $DATA(ARR)
Begin DoDot:1
+14 SET CN=0
FOR
SET CN=$ORDER(ARR(CN))
if CN=""
QUIT
Begin DoDot:2
+15 IF $PIECE(ARR(CN),U,11)'=STA
QUIT
+16 SET STR=$PIECE($PIECE(ARR(CN),U,1)," = ",2)
+17 SET STR=$PIECE(ARR(CN),U,3)_U_$PIECE(ARR(CN),U,4)_U_$PIECE(ARR(CN),U,6)_U
+18 SET STR=STR_$PIECE(ARR(CN),U,7)_U_$PIECE(ARR(CN),U,8)
+19 SET ^TMP($JOB,TAG,0)=^TMP($JOB,TAG,0)_U_STR
End DoDot:2
End DoDot:1
+20 KILL ARR,DATA
SET DATA=""
+21 DO EMPHRS
DO DETAIL
+22 QUIT
IRWSHT ; Incidence Rates Worksheet Report
+1 NEW COLHI,EMP,HRS
+2 SET ^TMP($JOB,TAG,1)="No Worksheet Data for this Station"
+3 SET COLHI=0
+4 KILL ARR,DATA
SET DATA=""
+5 DO EMPHRS
DO DETAIL
+6 QUIT
DETAIL ; now get employee information
LOG300 ; entry point for the OSHA 300 LOG
+1 NEW CN,CASES,COLF,DOI,FLD,IEN,INC,STATION,TYPE
+2 SET DOI=SDATE
SET CASES=0
SET CN=1
+3 FOR
SET DOI=$ORDER(^OOPS(2260,"AF",DOI))
if (DOI>EDATE)!(DOI="")
QUIT
SET IEN=0
Begin DoDot:1
+4 FOR
SET IEN=$ORDER(^OOPS(2260,"AF",DOI,"Y",IEN))
if IEN=""
QUIT
Begin DoDot:2
+5 SET STATION=$PIECE(^OOPS(2260,IEN,"2162A"),U,9)
IF $GET(STATION)'=STA
QUIT
+6 IF $PIECE(^OOPS(2260,IEN,0),U,6)>1
QUIT
+7 SET CASES=CASES+1
+8 IF TAG="IRWSHT"
Begin DoDot:3
+9 IF $DATA(^OOPS(2260,IEN,"OUTC","AC","A","J"))!$DATA(^OOPS(2260,IEN,"OUTC","AC","A","A"))
SET COLHI=COLHI+1
End DoDot:3
+10 IF TAG="SUM300A"
DO FLD95
+11 IF TAG="LOG300"
DO FLD95
Begin DoDot:3
+12 SET ARR(1)=$$GET1^DIQ(2260,IEN,.01)
SET ARR(2)=$$GET1^DIQ(2260,IEN,1)
+13 IF $$GET1^DIQ(2260,IEN,337,"I")="Y"
SET ARR(2)="Privacy Case"
+14 SET TYPE=$$GET1^DIQ(2260,IEN,3,"I")
+15 IF TYPE>10&(TYPE<15)
SET ARR(2)="Privacy Case"
+16 IF MENU="U"
SET ARR(2)=""
+17 SET INC=$$GET1^DIQ(2260,IEN,52,"I")
SET FLD=$SELECT(INC=1:111,INC=2:208,1:"")
+18 SET ARR(3)=$$GET1^DIQ(2260,IEN,FLD)
+19 SET ARR(4)=$PIECE($$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,4,"I")),2),"@")
+20 SET ARR(5)=$$GET1^DIQ(2260,IEN,27,"E")
+21 ;v2_P20 changed field to populate ARR(6) - Coluum F OSHA 300 log
+22 SET COLF=$$GET1^DIQ(2260,IEN,384)
SET ARR(6)=COLF
+23 IF (SDATE<3081231.9999&(EDATE>3081231.9999))
SET ARR(6)=COLF
+24 IF EDATE<3090101&(COLF="")
SET ARR(6)=$$GET1^DIQ(2260,IEN,3)_";"_$$GET1^DIQ(2260,IEN,30)
+25 SET DATA=ARR(1)_U_ARR(2)_U_ARR(3)_U_ARR(4)_U_ARR(5)_U_ARR(6)_U_ARR(7)_U
+26 SET DATA=DATA_ARR(8)_U_ARR(9)_U_ARR(10)
+27 SET ^TMP($JOB,TAG,CN)=DATA
SET CN=CN+1
End DoDot:3
End DoDot:2
End DoDot:1
+28 IF TAG="IRWSHT"
SET ^TMP($JOB,TAG,1)=CASES_U_COLHI_U_HRS
+29 IF TAG="SUM300A"
Begin DoDot:1
+30 SET DATA=CASES_U_EMP_U_HRS_U_COLG_U_COLH_U_COLI_U_COLJ_U_COLK_U_COLL_U
+31 SET DATA=DATA_COLM(1)_U_COLM(2)_U_COLM(3)_U_COLM(4)_U_COLM(5)_U_COLM(6)
+32 SET ^TMP($JOB,TAG,1)=DATA
End DoDot:1
+33 SET RESULTS=$NAME(^TMP($JOB,TAG))
+34 KILL ARR,DATA
+35 QUIT
FLD95 ; use OUTC subrecord to retrieve data
+1 NEW AVAIL,ED,SD,S0,INC,ILL,DAYA,DAYJ,DAYS,IEN95,OC,OUTC,S95,TDAY
+2 SET S0=$GET(^OOPS(2260,IEN,0))
SET INC=$PIECE(S0,U,7)
+3 SET ILL=$PIECE($GET(^OOPS(2260,IEN,"2162B")),U,15)
+4 SET TDAY=$$HTFM^XLFDT(+$HOROLOG)
+5 ; add days away & job transfer up only to 180 for log, 4 300A get all
+6 SET (DAYA,DAYJ,TAWAY)=0
SET IEN95=0
+7 FOR
SET IEN95=$ORDER(^OOPS(2260,IEN,"OUTC",IEN95))
if IEN95'>0
QUIT
Begin DoDot:1
+8 SET S95=$GET(^OOPS(2260,IEN,"OUTC",IEN95,0))
+9 SET SD=$PIECE(S95,U,1)
SET ED=$PIECE(S95,U,2)
SET OC=$PIECE(S95,U,3)
SET DAYS=0
+10 ; entry is deleted
IF $PIECE(S95,U,11)="D"
QUIT
+11 ;patch 11 - added logic that if TAG=LOG300 include all incident days
+12 ; up to 180, else 300A, only include date range incidents
+13 IF (TAG="SUM300A")
IF (EDATE<SD)
QUIT
+14 IF $GET(OC)'=""
SET OUTC(OC)=""
+15 IF TAG="SUM300A"
Begin DoDot:2
+16 IF $GET(ED)=""!($GET(ED)>EDATE)
SET DAYS=$$FMDIFF^XLFDT(EDATE,SD,1)+1
End DoDot:2
+17 IF TAG="LOG300"
IF ($GET(ED)="")
SET DAYS=$$FMDIFF^XLFDT(TDAY,SD,1)+1
+18 IF '$GET(DAYS)
SET DAYS=$SELECT(OC="A":$PIECE(S95,U,4),OC="J":$PIECE(S95,U,5),1:0)
+19 IF DAYA+DAYJ>179
QUIT
+20 SET AVAIL=0
+21 IF DAYS>179
SET AVAIL=(180-(DAYA+DAYJ))
+22 IF (DAYS<180)
Begin DoDot:2
+23 ;rra oops*25 - INC809171 account for exactly 180 days
+24 IF (DAYS+DAYA+DAYJ)<=180
SET AVAIL=DAYS
+25 IF (DAYS+DAYA+DAYJ)>180
SET AVAIL=(180-(DAYA+DAYJ))
End DoDot:2
+26 IF $GET(OC)="A"
SET DAYA=DAYA+AVAIL
+27 IF $GET(OC)="J"
SET DAYJ=DAYJ+AVAIL
End DoDot:1
+28 IF TAG="SUM300A"
Begin DoDot:1
+29 if $GET(INC)=1
SET COLM(1)=COLM(1)+1
+30 IF INC=2
Begin DoDot:2
+31 IF $GET(ILL)
SET COLM(ILL)=COLM(ILL)+1
+32 IF '$GET(ILL)
SET COLM(6)=COLM(6)+1
End DoDot:2
+33 SET COLK=COLK+DAYA
SET COLL=COLL+DAYJ
+34 IF $DATA(OUTC("D"))
SET COLG=COLG+1
QUIT
+35 IF $DATA(OUTC("A"))
SET COLH=COLH+1
QUIT
+36 IF $DATA(OUTC("J"))
SET COLI=COLI+1
QUIT
+37 IF $DATA(OUTC("O"))
SET COLJ=COLJ+1
QUIT
End DoDot:1
+38 IF TAG="LOG300"
Begin DoDot:1
+39 SET ARR(7)=""
SET ARR(10)=""
SET (ARR(8),ARR(9))=0
+40 IF INC=1
SET ARR(10)=1
+41 IF INC=2
if $GET(ILL)
SET ARR(10)=ILL
if '$GET(ILL)
SET ARR(10)=6
+42 SET ARR(8)=DAYA
SET ARR(9)=DAYJ
+43 IF $DATA(OUTC("D"))
SET ARR(7)="D"
SET (ARR(8),ARR(9))=0
QUIT
+44 IF $DATA(OUTC("A"))
SET ARR(7)="A"
QUIT
+45 IF $DATA(OUTC("J"))
SET ARR(7)="J"
QUIT
+46 IF $DATA(OUTC("O"))
SET ARR(7)="O"
QUIT
End DoDot:1
+47 QUIT
EMPHRS ; get Total Num Employees and Hours worked
+1 NEW CASES,ED,LV1,LV2,MON,OK,PAR,SD,SIEN,STR,WS,X,X1,X2
+2 SET (EMP,HRS,WS)=0
+3 SET PAR="^OOPS(2262,0)"
SET PAR=$QUERY(@PAR)
SET PAR=$QUERY(@PAR)
+4 SET LV1=$PIECE(PAR,",",2)
SET LV2=$PIECE(PAR,",",3)
+5 SET SIEN=$ORDER(^OOPS(2262,LV1,LV2,"B",STA,-1))
if SIEN=""
QUIT
+6 ; get month range to make sure all emp numbers and hours are entered
+7 SET SDATE=SDATE\1
+8 SET SD=$EXTRACT(SDATE,1,5)_"00"_$EXTRACT(SDATE,8,$LENGTH(SDATE))
+9 SET ED=$EXTRACT(EDATE,1,5)_"00"_$EXTRACT(EDATE,8,$LENGTH(EDATE))
+10 SET X1=$EXTRACT(ED,1,3)
SET X2=$EXTRACT(SD,1,3)
+11 IF X1>X2
Begin DoDot:1
+12 SET OK=0
SET X=(X1-X2)
if X>1
SET OK=(X-1)*12
+13 SET OK=OK+((12-$EXTRACT(SD,4,5))+1)+$EXTRACT(ED,4,5)
End DoDot:1
+14 IF X1=X2
SET OK=($EXTRACT(ED,4,5)-$EXTRACT(SD,4,5))+1
+15 SET MON=OK
+16 FOR
SET WS=$ORDER(^OOPS(2262,LV1,LV2,SIEN,2,WS))
if (WS'>0)
QUIT
Begin DoDot:1
+17 SET STR=^OOPS(2262,LV1,LV2,SIEN,2,WS,0)
+18 IF ($PIECE(STR,U)'<SD)&($PIECE(STR,U)'>ED)
Begin DoDot:2
+19 IF ($PIECE(STR,U,2)="")!($PIECE(STR,U,3)="")
QUIT
+20 SET EMP=EMP+$PIECE(STR,U,2)
SET HRS=HRS+$PIECE(STR,U,3)
SET OK=OK-1
End DoDot:2
End DoDot:1
+21 IF '$GET(OK)
SET EMP=EMP/MON
+22 IF $GET(OK)
SET (EMP,HRS)="INCOMPLETE DATA"
+23 QUIT
