Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (15 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSGUIR.m

    r613 r623  
    1 OOPSGUIR        ;WIOFO/LLH-RPC routine for misc reports ;03/16/04
    2         ;;2.0;ASISTS;**8,7,11,14**;Jun 03, 2002;Build 1
    3         ;
    4 ENT(RESULTS,INPUT,CALL) ; get the data for the report
    5         ;   Input:  INPUT - contains 3 values, the START AND END DATE,
    6         ;                   STATION. The Date of Occ (fld #4) is used to
    7         ;                   in/exclude claims from the report. If Station='ALL'
    8         ;                   then all claims are included, if not 'All', then
    9         ;                   only 1 station is included.
    10         ;            CALL - contains the report call which will invoke
    11         ;                   the appropriate M call
    12         ; Output: RESULTS - the results array passes data back to the client.
    13         N CAX,FI,LP,MENU,SDATE,STDT,STA,STATION,ENDDT,EDATE,TAG,X,Y,%DT
    14         S RESULTS(0)="Processing..."
    15         S STDT=$P($G(INPUT),U),ENDDT=$P($G(INPUT),U,2)
    16         S STA=$P($G(INPUT),U,3),TAG=CALL
    17         I (STDT="")!(ENDDT="")!(STA="")!(TAG="") D  Q
    18         . S RESULTS(0)="Input parameters missing, cannot run report." Q
    19         K ^TMP($J,TAG)
    20         S (SDATE,EDATE,MENU)=""
    21         S X=STDT D ^%DT S SDATE=Y
    22         S X=ENDDT D ^%DT S EDATE=Y
    23         ; SDATE made last time in day prior so start date correct
    24         I TAG="LOG300U" S TAG="LOG300",MENU="U"
    25         S SDATE=(SDATE-1)+.9999,EDATE=EDATE_".9999"
    26         D @TAG
    27         Q
    28 SERVICE ; Service/Detail Location report - patch 11
    29 DSPUTE  ; Reason for Dispute report. Patch 11
    30 FLD174  ; Report compiles filing instruction result counts
    31 FLD332  ; Use this tag for Reason for Controvert report. Patch 11
    32         N ARR,CODE,CN,LP,IEN,I,GOON,P2,TX
    33         S LP="",IEN="",CN=0
    34         I TAG="FLD174" D
    35         .S CODE=$P($G(^DD(2260,174,0)),U,3)
    36         .F I=1:1 S LP=$P(CODE,";",I) Q:$G(LP)=""  I $P(LP,":",2)'="" S ARR(LP)=0
    37         .S ARR(I_":No Data Entered")=0
    38         I TAG="FLD332" D
    39         .F I=1:1 Q:'$D(^OOPS(2262.4,I))  S ARR(I_":"_$P(^OOPS(2262.4,I,0),U))=0
    40         .S ARR(98_":Blk 36 also has text entered")=0
    41         .S ARR(99_":Controvert question checked Yes, but no Controvert Code entered")=0
    42         F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE)  D
    43         .F  S IEN=$O(^OOPS(2260,"AD",LP,IEN)) Q:IEN'>0  D
    44         ..I $$GET1^DIQ(2260,IEN,51,"I")>1 Q      ;only allow open/closed cases
    45         ..S CAX=$$GET1^DIQ(2260,IEN,52,"I")
    46         ..I TAG'="SERVICE"&(CAX=2) Q                       ;only allow CA1's
    47         ..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9)
    48         ..I ($G(STA)'="A"),(STATION'=STA) Q        ;get correct station
    49         ..;patch 11 - sent to OOPSGUIF due to size this routine
    50         ..I TAG="DSPUTE" D DSPUTE^OOPSGUIF
    51         ..I TAG="SERVICE" D SERVICE^OOPSGUIU
    52         ..; Filing instructions report
    53         ..I TAG="FLD174" D
    54         ...S FI=$$GET1^DIQ(2260,IEN,174,"I")_":"_$$GET1^DIQ(2260,IEN,174)
    55         ...I $$GET1^DIQ(2260,IEN,174)="" S FI=I_":No Data Entered"
    56         ...S ARR(FI)=ARR(FI)+1
    57         ...;patch 11 - Reason for controvert report
    58         ..I TAG="FLD332" D
    59         ...;first Agency Controvert must = "Y" to be counted
    60         ...S GOON=$$GET1^DIQ(2260,IEN,165.1,"I") I $G(GOON)'="Y" D  Q
    61         ....S:'$D(ARR("999:Case not controverted, no controvert code expected")) ARR("999:Case not controverted, no controvert code expected")=0
    62         ....S ARR("999:Case not controverted, no controvert code expected")=ARR("999:Case not controverted, no controvert code expected")+1
    63         ...S FI=$$GET1^DIQ(2260,IEN,332,"I")_":"_$$GET1^DIQ(2260,IEN,332)
    64         ...I $$GET1^DIQ(2260,IEN,332)="" S FI=99_":Controvert question checked Yes, but no Controvert Code entered"
    65         ...S ARR(FI)=ARR(FI)+1
    66         ...I $G(^OOPS(2260,IEN,"CA1K",1,0))'="" D
    67         ....;if case is diputed, don't count in Controvert rpt - quit
    68         ....S GOON=$$GET1^DIQ(2260,IEN,165.2,"I") I $G(GOON)="Y" Q
    69         ....S ARR(98_":Blk 36 also has text entered")=ARR(98_":Blk 36 also has text entered")+1
    70         I TAG'="DSPUTE",(TAG'="SERVICE") D
    71         .S CN=0,FI="",P2=""
    72         .F  S FI=$O(ARR(FI)) Q:FI=""  D
    73         ..S CN=$P(FI,":"),P2=$P(FI,":",2),CODE=0
    74         ..I TAG="FLD332" S TX=$O(^OOPS(2262.4,"B",P2,"")) I $G(TX) S CODE=$P(^OOPS(2262.4,TX,0),U,2)
    75         ..S ^TMP($J,TAG,CN)=P2_U_CODE_U_ARR(FI)
    76         ..; rearrange 'bogus' Controvert Codes for report formating
    77         ..I TAG="FLD332",(CN>97) S ^TMP($J,TAG,CN)=U_P2_U_ARR(FI)
    78         I TAG="SERVICE" D CMPLSRV^OOPSGUIU
    79         I TAG="DSPUTE" D DSPUTE^OOPSGUIU
    80         S RESULTS=$NA(^TMP($J,TAG))
    81         Q
    82 SUM300A ; Summary of Work-related injuries and illness report
    83         N CN,EMP,FAC,HRS,STATE,STR
    84         N COLG,COLH,COLI,COLJ,COLK,COLL,COLM
    85         S (COLG,COLH,COLI,COLJ,COLK,COLL)=0
    86         S (COLM(1),COLM(2),COLM(3),COLM(4),COLM(5),COLM(6))=0
    87         S ^TMP($J,TAG,0)="No worksheet data for this station."
    88         S FAC=$$GET1^DIQ(4,STA,.01,"E")
    89         K ARR D STATINFO^OOPSGUI3(.ARR,STA) I $D(ARR) D
    90         .S STATE=$P($G(ARR(0)),U,3)
    91         .I $G(STATE)'="" D
    92         ..S STATE=$O(^DIC(5,"B",STATE,""))
    93         ..S $P(ARR(0),U,3)=$P(^DIC(5,STATE,0),U,2)
    94         .S ^TMP($J,TAG,0)=FAC_U_ARR(0)
    95         K ARR D SITEPGET^OOPSGUI6(.ARR,"OSHA300") I $D(ARR) D
    96         .S CN=0 F  S CN=$O(ARR(CN)) Q:CN=""  D
    97         ..I $P(ARR(CN),U,11)'=STA Q
    98         ..S STR=$P($P(ARR(CN),U,1)," = ",2)
    99         ..S STR=$P(ARR(CN),U,3)_U_$P(ARR(CN),U,4)_U_$P(ARR(CN),U,6)_U
    100         ..S STR=STR_$P(ARR(CN),U,7)_U_$P(ARR(CN),U,8)
    101         ..S ^TMP($J,TAG,0)=^TMP($J,TAG,0)_U_STR
    102         K ARR,DATA S DATA=""
    103         D EMPHRS,DETAIL
    104         Q
    105 IRWSHT  ; Incidence Rates Worksheet Report
    106         N COLHI,EMP,HRS
    107         S ^TMP($J,TAG,1)="No Worksheet Data for this Station"
    108         S COLHI=0
    109         K ARR,DATA S DATA=""
    110         D EMPHRS,DETAIL
    111         Q
    112 DETAIL  ; now get employee information
    113 LOG300  ; entry point for the OSHA 300 LOG
    114         N CN,CASES,DOI,FLD,IEN,INC,STATION,TYPE
    115         S DOI=SDATE,CASES=0,CN=1
    116         F  S DOI=$O(^OOPS(2260,"AF",DOI)) Q:(DOI>EDATE)!(DOI="")  S IEN=0 D
    117         .F  S IEN=$O(^OOPS(2260,"AF",DOI,"Y",IEN)) Q:IEN=""  D
    118         ..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9) I $G(STATION)'=STA Q
    119         ..I $P(^OOPS(2260,IEN,0),U,6)>1 Q
    120         ..S CASES=CASES+1
    121         ..I TAG="IRWSHT" D
    122         ...I $D(^OOPS(2260,IEN,"OUTC","AC","A","J"))!$D(^OOPS(2260,IEN,"OUTC","AC","A","A")) S COLHI=COLHI+1
    123         ..I TAG="SUM300A" D FLD95
    124         ..I TAG="LOG300" D FLD95 D
    125         ...S ARR(1)=$$GET1^DIQ(2260,IEN,.01),ARR(2)=$$GET1^DIQ(2260,IEN,1)
    126         ...I $$GET1^DIQ(2260,IEN,337,"I")="Y" S ARR(2)="Privacy Case"
    127         ...S TYPE=$$GET1^DIQ(2260,IEN,3,"I")
    128         ...I TYPE>10&(TYPE<15) S ARR(2)="Privacy Case"
    129         ...I MENU="U" S ARR(2)=""
    130         ...S INC=$$GET1^DIQ(2260,IEN,52,"I"),FLD=$S(INC=1:111,INC=2:208,1:"")
    131         ...S ARR(3)=$$GET1^DIQ(2260,IEN,FLD)
    132         ...S ARR(4)=$P($$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,4,"I")),2),"@")
    133         ...S ARR(5)=$$GET1^DIQ(2260,IEN,27,"E")
    134         ...S ARR(6)=$$GET1^DIQ(2260,IEN,3)_";"_$$GET1^DIQ(2260,IEN,30)
    135         ...S DATA=ARR(1)_U_ARR(2)_U_ARR(3)_U_ARR(4)_U_ARR(5)_U_ARR(6)_U_ARR(7)_U
    136         ...S DATA=DATA_ARR(8)_U_ARR(9)_U_ARR(10)
    137         ...S ^TMP($J,TAG,CN)=DATA,CN=CN+1
    138         I TAG="IRWSHT" S ^TMP($J,TAG,1)=CASES_U_COLHI_U_HRS
    139         I TAG="SUM300A" D
    140         .S DATA=CASES_U_EMP_U_HRS_U_COLG_U_COLH_U_COLI_U_COLJ_U_COLK_U_COLL_U
    141         .S DATA=DATA_COLM(1)_U_COLM(2)_U_COLM(3)_U_COLM(4)_U_COLM(5)_U_COLM(6)
    142         .S ^TMP($J,TAG,1)=DATA
    143         S RESULTS=$NA(^TMP($J,TAG))
    144         K ARR,DATA
    145         Q
    146 FLD95   ; use OUTC subrecord to retrieve data
    147         N AVAIL,ED,SD,S0,INC,ILL,DAYA,DAYJ,DAYS,IEN95,OC,OUTC,S95,TDAY
    148         S S0=$G(^OOPS(2260,IEN,0)),INC=$P(S0,U,7)
    149         S ILL=$P($G(^OOPS(2260,IEN,"2162B")),U,15)
    150         S TDAY=$$HTFM^XLFDT(+$H)
    151         ; add days away & job transfer up only to 180 for log, 4 300A get all
    152         S (DAYA,DAYJ,TAWAY)=0,IEN95=0
    153         F  S IEN95=$O(^OOPS(2260,IEN,"OUTC",IEN95)) Q:IEN95'>0  D
    154         .S S95=$G(^OOPS(2260,IEN,"OUTC",IEN95,0))
    155         .S SD=$P(S95,U,1),ED=$P(S95,U,2),OC=$P(S95,U,3),DAYS=0
    156         .I $P(S95,U,11)="D" Q      ; entry is deleted
    157         .;patch 11 - added logic that if TAG=LOG300 include all incident days
    158         .;           up to 180, else 300A, only include date range incidents
    159         .I (TAG="SUM300A"),(EDATE<SD) Q
    160         .I $G(OC)'="" S OUTC(OC)=""
    161         .I TAG="SUM300A" D
    162         ..I $G(ED)=""!($G(ED)>EDATE) S DAYS=$$FMDIFF^XLFDT(EDATE,SD,1)+1
    163         .I TAG="LOG300",($G(ED)="") S DAYS=$$FMDIFF^XLFDT(TDAY,SD,1)+1
    164         .I '$G(DAYS) S DAYS=$S(OC="A":$P(S95,U,4),OC="J":$P(S95,U,5),1:0)
    165         .I DAYA+DAYJ>179 Q
    166         .S AVAIL=0
    167         .I DAYS>179 S AVAIL=(180-(DAYA+DAYJ))
    168         .I (DAYS<180) D
    169         ..I (DAYS+DAYA+DAYJ)<180 S AVAIL=DAYS
    170         ..I (DAYS+DAYA+DAYJ)>180 S AVAIL=(180-(DAYA+DAYJ))
    171         .I $G(OC)="A" S DAYA=DAYA+AVAIL
    172         .I $G(OC)="J" S DAYJ=DAYJ+AVAIL
    173         I TAG="SUM300A" D
    174         .S:$G(INC)=1 COLM(1)=COLM(1)+1
    175         .I INC=2 D
    176         ..I $G(ILL) S COLM(ILL)=COLM(ILL)+1
    177         ..I '$G(ILL) S COLM(6)=COLM(6)+1
    178         .S COLK=COLK+DAYA,COLL=COLL+DAYJ
    179         .I $D(OUTC("D")) S COLG=COLG+1 Q
    180         .I $D(OUTC("A")) S COLH=COLH+1 Q
    181         .I $D(OUTC("J")) S COLI=COLI+1 Q
    182         .I $D(OUTC("O")) S COLJ=COLJ+1 Q
    183         I TAG="LOG300" D
    184         .S ARR(7)="",ARR(10)="",(ARR(8),ARR(9))=0
    185         .I INC=1 S ARR(10)=1
    186         .I INC=2 S:$G(ILL) ARR(10)=ILL S:'$G(ILL) ARR(10)=6
    187         .S ARR(8)=DAYA,ARR(9)=DAYJ
    188         .I $D(OUTC("D")) S ARR(7)="D" S (ARR(8),ARR(9))=0 Q
    189         .I $D(OUTC("A")) S ARR(7)="A" Q
    190         .I $D(OUTC("J")) S ARR(7)="J" Q
    191         .I $D(OUTC("O")) S ARR(7)="O" Q
    192         Q
    193 EMPHRS  ; get Total Num Employees and Hours worked
    194         N CASES,ED,LV1,LV2,MON,OK,PAR,SD,SIEN,STR,WS,X,X1,X2
    195         S (EMP,HRS,WS)=0
    196         S PAR="^OOPS(2262,0)",PAR=$Q(@PAR),PAR=$Q(@PAR)
    197         S LV1=$P(PAR,",",2),LV2=$P(PAR,",",3)
    198         S SIEN=$O(^OOPS(2262,LV1,LV2,"B",STA,-1)) Q:SIEN=""
    199         ; get month range to make sure all emp numbers and hours are entered
    200         S SDATE=SDATE\1
    201         S SD=$E(SDATE,1,5)_"00"_$E(SDATE,8,$L(SDATE))
    202         S ED=$E(EDATE,1,5)_"00"_$E(EDATE,8,$L(EDATE))
    203         S X1=$E(ED,1,3),X2=$E(SD,1,3)
    204         I X1>X2 D
    205         .S OK=0,X=(X1-X2) S:X>1 OK=(X-1)*12
    206         .S OK=OK+((12-$E(SD,4,5))+1)+$E(ED,4,5)
    207         I X1=X2 S OK=($E(ED,4,5)-$E(SD,4,5))+1
    208         S MON=OK
    209         F  S WS=$O(^OOPS(2262,LV1,LV2,SIEN,2,WS)) Q:(WS'>0)  D
    210         .S STR=^OOPS(2262,LV1,LV2,SIEN,2,WS,0)
    211         .I ($P(STR,U)'<SD)&($P(STR,U)'>ED) D
    212         ..I ($P(STR,U,2)="")!($P(STR,U,3)="") Q
    213         ..S EMP=EMP+$P(STR,U,2),HRS=HRS+$P(STR,U,3),OK=OK-1
    214         I '$G(OK) S EMP=EMP/MON
    215         I $G(OK) S (EMP,HRS)="INCOMPLETE DATA"
    216         Q
     1OOPSGUIR ;WIOFO/LLH-RPC routine for misc reports ;03/16/04
     2 ;;2.0;ASISTS;**8,7,11**;Jun 03, 2002
     3 ;
     4ENT(RESULTS,INPUT,CALL) ; get the data for the report
     5 ;   Input:  INPUT - contains 3 values, the START AND END DATE,
     6 ;                   STATION. The Date of Occ (fld #4) is used to
     7 ;                   in/exclude claims from the report. If Station='ALL'
     8 ;                   then all claims are included, if not 'All', then
     9 ;                   only 1 station is included.
     10 ;            CALL - contains the report call which will invoke
     11 ;                   the appropriate M call
     12 ; Output: RESULTS - the results array passes data back to the client.
     13 N CAX,FI,LP,MENU,SDATE,STDT,STA,STATION,ENDDT,EDATE,TAG,X,Y,%DT
     14 S RESULTS(0)="Processing..."
     15 S STDT=$P($G(INPUT),U),ENDDT=$P($G(INPUT),U,2)
     16 S STA=$P($G(INPUT),U,3),TAG=CALL
     17 I (STDT="")!(ENDDT="")!(STA="")!(TAG="") D  Q
     18 . S RESULTS(0)="Input parameters missing, cannot run report." Q
     19 K ^TMP($J,TAG)
     20 S (SDATE,EDATE,MENU)=""
     21 S X=STDT D ^%DT S SDATE=Y
     22 S X=ENDDT D ^%DT S EDATE=Y
     23 ; SDATE made last time in day prior so start date correct
     24 I TAG="LOG300U" S TAG="LOG300",MENU="U"
     25 S SDATE=(SDATE-1)+.9999,EDATE=EDATE_".9999"
     26 D @TAG
     27 Q
     28SERVICE ; Service/Detail Location report - patch 11
     29DSPUTE ; Reason for Dispute report. Patch 11
     30FLD174 ; Report compiles filing instruction result counts
     31FLD332 ; Use this tag for Reason for Controvert report. Patch 11
     32 N ARR,CODE,CN,LP,IEN,I,GOON,P2,TX
     33 S LP="",IEN="",CN=0
     34 I TAG="FLD174" D
     35 .S CODE=$P($G(^DD(2260,174,0)),U,3)
     36 .F I=1:1 S LP=$P(CODE,";",I) Q:$G(LP)=""  I $P(LP,":",2)'="" S ARR(LP)=0
     37 .S ARR(I_":No Data Entered")=0
     38 I TAG="FLD332" D
     39 .F I=1:1 Q:'$D(^OOPS(2262.4,I))  S ARR(I_":"_$P(^OOPS(2262.4,I,0),U))=0
     40 .S ARR(98_":Blk 36 also has text entered")=0
     41 .S ARR(99_":Controvert question checked Yes, but no Controvert Code entered")=0
     42 F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE)  D
     43 .F  S IEN=$O(^OOPS(2260,"AD",LP,IEN)) Q:IEN'>0  D
     44 ..I $$GET1^DIQ(2260,IEN,51,"I")>1 Q      ;only allow open/closed cases
     45 ..S CAX=$$GET1^DIQ(2260,IEN,52,"I")
     46 ..I TAG'="SERVICE"&(CAX=2) Q                       ;only allow CA1's
     47 ..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9)
     48 ..I ($G(STA)'="A"),(STATION'=STA) Q        ;get correct station
     49 ..;patch 11 - sent to OOPSGUIF due to size this routine
     50 ..I TAG="DSPUTE" D DSPUTE^OOPSGUIF
     51 ..I TAG="SERVICE" D SERVICE^OOPSGUIU
     52 ..; Filing instructions report
     53 ..I TAG="FLD174" D
     54 ...S FI=$$GET1^DIQ(2260,IEN,174,"I")_":"_$$GET1^DIQ(2260,IEN,174)
     55 ...I $$GET1^DIQ(2260,IEN,174)="" S FI=I_":No Data Entered"
     56 ...S ARR(FI)=ARR(FI)+1
     57 ...;patch 11 - Reason for controvert report
     58 ..I TAG="FLD332" D
     59 ...;first Agency Controvert must = "Y" to be counted
     60 ...S GOON=$$GET1^DIQ(2260,IEN,165.1,"I") I $G(GOON)'="Y" D  Q
     61 ....S:'$D(ARR("999:Case not controverted, no controvert code expected")) ARR("999:Case not controverted, no controvert code expected")=0
     62 ....S ARR("999:Case not controverted, no controvert code expected")=ARR("999:Case not controverted, no controvert code expected")+1
     63 ...S FI=$$GET1^DIQ(2260,IEN,332,"I")_":"_$$GET1^DIQ(2260,IEN,332)
     64 ...I $$GET1^DIQ(2260,IEN,332)="" S FI=99_":Controvert question checked Yes, but no Controvert Code entered"
     65 ...S ARR(FI)=ARR(FI)+1
     66 ...I $G(^OOPS(2260,IEN,"CA1K",1,0))'="" D
     67 ....;if case is diputed, don't count in Controvert rpt - quit
     68 ....S GOON=$$GET1^DIQ(2260,IEN,165.2,"I") I $G(GOON)="Y" Q
     69 ....S ARR(98_":Blk 36 also has text entered")=ARR(98_":Blk 36 also has text entered")+1
     70 I TAG'="DSPUTE",(TAG'="SERVICE") D
     71 .S CN=0,FI="",P2=""
     72 .F  S FI=$O(ARR(FI)) Q:FI=""  D
     73 ..S CN=$P(FI,":"),P2=$P(FI,":",2),CODE=0
     74 ..I TAG="FLD332" S TX=$O(^OOPS(2262.4,"B",P2,"")) I $G(TX) S CODE=$P(^OOPS(2262.4,TX,0),U,2)
     75 ..S ^TMP($J,TAG,CN)=P2_U_CODE_U_ARR(FI)
     76 ..; rearrange 'bogus' Controvert Codes for report formating
     77 ..I TAG="FLD332",(CN>97) S ^TMP($J,TAG,CN)=U_P2_U_ARR(FI)
     78 I TAG="SERVICE" D CMPLSRV^OOPSGUIU
     79 I TAG="DSPUTE" D DSPUTE^OOPSGUIU
     80 S RESULTS=$NA(^TMP($J,TAG))
     81 Q
     82SUM300A ; Summary of Work-related injuries and illness report
     83 N CN,EMP,FAC,HRS,STATE,STR
     84 N COLG,COLH,COLI,COLJ,COLK,COLL,COLM
     85 S (COLG,COLH,COLI,COLJ,COLK,COLL)=0
     86 S (COLM(1),COLM(2),COLM(3),COLM(4),COLM(5),COLM(6))=0
     87 S ^TMP($J,TAG,0)="No worksheet data for this station."
     88 S FAC=$$GET1^DIQ(4,STA,.01,"E")
     89 K ARR D STATINFO^OOPSGUI3(.ARR,STA) I $D(ARR) D
     90 .S STATE=$P($G(ARR(0)),U,3)
     91 .I $G(STATE)'="" D
     92 ..S STATE=$O(^DIC(5,"B",STATE,""))
     93 ..S $P(ARR(0),U,3)=$P(^DIC(5,STATE,0),U,2)
     94 .S ^TMP($J,TAG,0)=FAC_U_ARR(0)
     95 K ARR D SITEPGET^OOPSGUI6(.ARR,"OSHA300") I $D(ARR) D
     96 .S CN=0 F  S CN=$O(ARR(CN)) Q:CN=""  D
     97 ..I $P(ARR(CN),U,11)'=STA Q
     98 ..S STR=$P($P(ARR(CN),U,1)," = ",2)
     99 ..S STR=$P(ARR(CN),U,3)_U_$P(ARR(CN),U,4)_U_$P(ARR(CN),U,6)_U
     100 ..S STR=STR_$P(ARR(CN),U,7)_U_$P(ARR(CN),U,8)
     101 ..S ^TMP($J,TAG,0)=^TMP($J,TAG,0)_U_STR
     102 K ARR,DATA S DATA=""
     103 D EMPHRS,DETAIL
     104 Q
     105IRWSHT ; Incidence Rates Worksheet Report
     106 N COLHI,EMP,HRS
     107 S ^TMP($J,TAG,1)="No Worksheet Data for this Station"
     108 S COLHI=0
     109 K ARR,DATA S DATA=""
     110 D EMPHRS,DETAIL
     111 Q
     112DETAIL ; now get employee information
     113LOG300 ; entry point for the OSHA 300 LOG
     114 N CN,CASES,DOI,FLD,IEN,INC,STATION,TYPE
     115 S DOI=SDATE,CASES=0,CN=1
     116 F  S DOI=$O(^OOPS(2260,"AF",DOI)) Q:(DOI>EDATE)!(DOI="")  S IEN=0 D
     117 .F  S IEN=$O(^OOPS(2260,"AF",DOI,"Y",IEN)) Q:IEN=""  D
     118 ..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9) I $G(STATION)'=STA Q
     119 ..I $P(^OOPS(2260,IEN,0),U,6)>1 Q
     120 ..S CASES=CASES+1
     121 ..I TAG="IRWSHT" D
     122 ...I $D(^OOPS(2260,IEN,"OUTC","AC","A","J"))!$D(^OOPS(2260,IEN,"OUTC","AC","A","A")) S COLHI=COLHI+1
     123 ..I TAG="SUM300A" D FLD95
     124 ..I TAG="LOG300" D FLD95 D
     125 ...S ARR(1)=$$GET1^DIQ(2260,IEN,.01),ARR(2)=$$GET1^DIQ(2260,IEN,1)
     126 ...I $$GET1^DIQ(2260,IEN,337,"I")="Y" S ARR(2)="Privacy Case"
     127 ...S TYPE=$$GET1^DIQ(2260,IEN,3,"I")
     128 ...I TYPE>10&(TYPE<15) S ARR(2)="Privacy Case"
     129 ...I MENU="U" S ARR(2)=""
     130 ...S INC=$$GET1^DIQ(2260,IEN,52,"I"),FLD=$S(INC=1:111,INC=2:208,1:"")
     131 ...S ARR(3)=$$GET1^DIQ(2260,IEN,FLD)
     132 ...S ARR(4)=$P($$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,4,"I")),2),"@")
     133 ...S ARR(5)=$$GET1^DIQ(2260,IEN,27,"E")
     134 ...S ARR(6)=$$GET1^DIQ(2260,IEN,3)_";"_$$GET1^DIQ(2260,IEN,30)
     135 ...S DATA=ARR(1)_U_ARR(2)_U_ARR(3)_U_ARR(4)_U_ARR(5)_U_ARR(6)_U_ARR(7)_U
     136 ...S DATA=DATA_ARR(8)_U_ARR(9)_U_ARR(10)
     137 ...S ^TMP($J,TAG,CN)=DATA,CN=CN+1
     138 I TAG="IRWSHT" S ^TMP($J,TAG,1)=CASES_U_COLHI_U_HRS
     139 I TAG="SUM300A" D
     140 .S DATA=CASES_U_EMP_U_HRS_U_COLG_U_COLH_U_COLI_U_COLJ_U_COLK_U_COLL_U
     141 .S DATA=DATA_COLM(1)_U_COLM(2)_U_COLM(3)_U_COLM(4)_U_COLM(5)_U_COLM(6)
     142 .S ^TMP($J,TAG,1)=DATA
     143 S RESULTS=$NA(^TMP($J,TAG))
     144 K ARR,DATA
     145 Q
     146FLD95 ; use OUTC subrecord to retrieve data
     147 N AVAIL,ED,SD,S0,INC,ILL,DAYA,DAYJ,DAYS,IEN95,OC,OUTC,S95,TDAY
     148 S S0=$G(^OOPS(2260,IEN,0)),INC=$P(S0,U,7)
     149 S ILL=$P($G(^OOPS(2260,IEN,"2162B")),U,15)
     150 S TDAY=$$HTFM^XLFDT(+$H)
     151 ; add days away & job transfer up only to 180 for log, 4 300A get all
     152 S (DAYA,DAYJ,TAWAY)=0,IEN95=0
     153 F  S IEN95=$O(^OOPS(2260,IEN,"OUTC",IEN95)) Q:IEN95'>0  D
     154 .S S95=$G(^OOPS(2260,IEN,"OUTC",IEN95,0))
     155 .S SD=$P(S95,U,1),ED=$P(S95,U,2),OC=$P(S95,U,3),DAYS=0
     156 .I $P(S95,U,11)="D" Q      ; entry is deleted
     157 .;patch 11 - added logic that if TAG=LOG300 include all incident days
     158 .;           up to 180, else 300A, only include date range incidents
     159 .I (TAG="SUM300A"),(EDATE<SD) Q
     160 .I $G(OC)'="" S OUTC(OC)=""
     161 .I TAG="SUM300A" D
     162 ..I $G(ED)=""!($G(ED)>EDATE) S DAYS=$$FMDIFF^XLFDT(EDATE,SD,1)+1
     163 .I TAG="LOG300",($G(ED)="") S DAYS=$$FMDIFF^XLFDT(TDAY,SD,1)+1
     164 .I '$G(DAYS) S DAYS=$S(OC="A":$P(S95,U,4),OC="J":$P(S95,U,5),1:0)
     165 .I DAYA+DAYJ>180 Q
     166 .S AVAIL=0
     167 .I DAYS>180 S AVAIL=180
     168 .I (DAYS<180) D
     169 ..I (DAYS+DAYA+DAYJ)<180 S AVAIL=DAYS
     170 ..I (DAYS+DAYA+DAYJ)>180 S AVAIL=(180-(DAYA+DAYJ))
     171 .I $G(OC)="A" S DAYA=DAYA+AVAIL
     172 .I $G(OC)="J" S DAYJ=DAYJ+AVAIL
     173 I TAG="SUM300A" D
     174 .S:$G(INC)=1 COLM(1)=COLM(1)+1
     175 .I INC=2 D
     176 ..I $G(ILL) S COLM(ILL)=COLM(ILL)+1
     177 ..I '$G(ILL) S COLM(6)=COLM(6)+1
     178 .S COLK=COLK+DAYA,COLL=COLL+DAYJ
     179 .I $D(OUTC("D")) S COLG=COLG+1 Q
     180 .I $D(OUTC("A")) S COLH=COLH+1 Q
     181 .I $D(OUTC("J")) S COLI=COLI+1 Q
     182 .I $D(OUTC("O")) S COLJ=COLJ+1 Q
     183 I TAG="LOG300" D
     184 .S ARR(7)="",ARR(10)="",(ARR(8),ARR(9))=0
     185 .I INC=1 S ARR(10)=1
     186 .I INC=2 S:$G(ILL) ARR(10)=ILL S:'$G(ILL) ARR(10)=6
     187 .S ARR(8)=DAYA,ARR(9)=DAYJ
     188 .I $D(OUTC("D")) S ARR(7)="D" S (ARR(8),ARR(9))=0 Q
     189 .I $D(OUTC("A")) S ARR(7)="A" Q
     190 .I $D(OUTC("J")) S ARR(7)="J" Q
     191 .I $D(OUTC("O")) S ARR(7)="O" Q
     192 Q
     193EMPHRS ; get Total Num Employees and Hours worked
     194 N CASES,ED,LV1,LV2,MON,OK,PAR,SD,SIEN,STR,WS,X,X1,X2
     195 S (EMP,HRS,WS)=0
     196 S PAR="^OOPS(2262,0)",PAR=$Q(@PAR),PAR=$Q(@PAR)
     197 S LV1=$P(PAR,",",2),LV2=$P(PAR,",",3)
     198 S SIEN=$O(^OOPS(2262,LV1,LV2,"B",STA,-1)) Q:SIEN=""
     199 ; get month range to make sure all emp numbers and hours are entered
     200 S SDATE=SDATE\1
     201 S SD=$E(SDATE,1,5)_"00"_$E(SDATE,8,$L(SDATE))
     202 S ED=$E(EDATE,1,5)_"00"_$E(EDATE,8,$L(EDATE))
     203 S X1=$E(ED,1,3),X2=$E(SD,1,3)
     204 I X1>X2 D
     205 .S OK=0,X=(X1-X2) S:X>1 OK=(X-1)*12
     206 .S OK=OK+(($E(ED,4,5)-$E(SD,4,5))+1)+$E(SD,4,5)
     207 I X1=X2 S OK=($E(ED,4,5)-$E(SD,4,5))+1
     208 S MON=OK
     209 F  S WS=$O(^OOPS(2262,LV1,LV2,SIEN,2,WS)) Q:(WS'>0)  D
     210 .S STR=^OOPS(2262,LV1,LV2,SIEN,2,WS,0)
     211 .I ($P(STR,U)'<SD)&($P(STR,U)'>ED) D
     212 ..I ($P(STR,U,2)="")!($P(STR,U,3)="") Q
     213 ..S EMP=EMP+$P(STR,U,2),HRS=HRS+$P(STR,U,3),OK=OK-1
     214 I '$G(OK) S EMP=EMP/MON
     215 I $G(OK) S (EMP,HRS)="INCOMPLETE DATA"
     216 Q
Note: See TracChangeset for help on using the changeset viewer.