- OOPSLOG ;HINES CIOFO/GB-Log of Federal Occupational Injuries and Illnesses ;8/15/96
- ;;2.0;ASISTS;;Jun 03, 2002
- N CN,CL,DA,DASHES,DATE,EX,FCILL,FCINJ,FCINJILL,FYR,FY,HDR,HDR1,HDR2
- N HDRFLG,ILL,INC,INJ,INJILL,LIN,LP1,LTILL,LTINJ,LTINJILL,LYR,OUT,PG,STA
- N RANGE
- SDED N DIR,DIRUT,DUOUT,X,Y,SD,ED,SDT,EDT
- S DIR(0)="D^2981001:DT:EX"
- S DIR("A")="Starting Date for the Report"
- S DIR("?")="Select a Starting Date from the range displayed."
- D ^DIR
- G:$D(DIRUT) EXIT
- S SD=Y,SDT=Y(0)
- K DIR,DIRUT,DUOUT,X,Y S DIR(0)="D^2981001:DT:EX"
- S DIR("A")="Ending Date for the Report"
- S DIR("?")="Select a Ending Date from the range displayed"
- D ^DIR
- G:$D(DIRUT) EXIT
- S ED=Y,EDT=Y(0)
- I $$FMDIFF^XLFDT(ED,SD,1)'>0 W !?5,"The Ending Date cannot be before or on the Starting Date, please re-enter this data." G SDED
- S RANGE="for Period "_SDT_" - "_EDT
- I $D(EV) S INC=0,HDR1="Employees and volunteers only" G PREDEV
- K DIR S DIR(0)="SA^E/V:Employees and volunteers only;A:All cases",DIR("A")="Cases to be included: " D ^DIR K DIR
- G:$D(DIRUT) EXIT
- S EV=Y
- K DIR S DIR(0)="Y",DIR("A")="Include names of persons involved",DIR("B")="Yes" D ^DIR K DIR
- G:$D(DIRUT) EXIT
- S INC=Y
- ; Patch 5 -Get Station Number
- PREDEV S OUT=""
- D STATION(.STA,.OUT)
- G:$D(DIRUT)!(OUT) EXIT
- DEV K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP EXIT
- I $D(IO("Q")) D TASK G EXIT
- U IO D PRT D ^%ZISC K %ZIS,IOP G EXIT
- PRT S PG=0
- S (INJ,ILL,FCINJ,FCILL,LTINJ,LTILL)=0
- S EX="",LIN=$S(IOST?1"C".E:IOSL-4,1:IOSL-5) ; was 5 and 6
- K DASHES S $P(DASHES,"-",80)="-"
- D NOW^%DTC S DATE=%,Y=DATE X ^DD("DD") S DATE=Y
- S HDR=$S($G(NS):"Log of Needlestick Incidents ",1:"Log of Federal Occupational Injuries and Illnesses ")
- S HDR1=$S(EV="E/V":"Employees and volunteers only",1:"All cases")
- ; Patch 5 - change for Station Number looping
- S LP1=""
- I STA="A" D G EXIT
- . F S LP1=$O(^OOPS(2260,"D",LP1)) Q:LP1=""!(EX=U) S HDRFLG=0 D
- .. S DA=0 F S DA=$O(^OOPS(2260,"D",LP1,DA)) D:DA="" LOGSUM Q:DA=""!(EX=U) D DATA
- I STA'="A" D G EXIT
- . S LP1=STA,HDRFLG=0
- . S DA=0 F S DA=$O(^OOPS(2260,"D",LP1,DA)) D:DA="" LOGSUM Q:DA=""!(EX=U) D DATA
- EXIT ; Clean up and exit
- K POP,X,Y,%,NS,EV
- Q
- DATA ;
- N CASE,OOPS,YR,DIC,DIQ,DR,CD
- S CASE=$$GET1^DIQ(2260,DA,.01)
- S YR=$E(CASE,1,4)
- S CD=($P(^OOPS(2260,DA,0),"^",5))\1
- I ($$FMDIFF^XLFDT(CD,SD,1)<0)!($$FMDIFF^XLFDT(CD,ED,1)>0) Q
- K OOPS
- S DIC="^OOPS(2260,"
- S DR=".01;2;3;4;1;15;14;29;30;33;37;51;52;82;83;84;85;86"
- S DIQ="OOPS",DIQ(0)="IE" D EN^DIQ1
- I $G(NS),OOPS(2260,DA,3,"I")<11 Q
- I EV="E/V","1,2,6,"'[OOPS(2260,DA,2,"I")_"," Q
- Q:OOPS(2260,DA,51,"E")="Deleted"
- Q:OOPS(2260,DA,51,"E")="Replaced by amendment"
- ; Patch 9 fix summary logic
- I OOPS(2260,DA,52,"E")="Injury" S INJ=INJ+1 D
- . S:OOPS(2260,DA,29,"E")="Death" FCINJ=FCINJ+1
- . S:OOPS(2260,DA,33,"E")="Yes" LTINJ=LTINJ+1
- I OOPS(2260,DA,52,"E")="Illness/disease" S ILL=ILL+1 D
- . S:OOPS(2260,DA,29,"E")="Death" FCILL=FCILL+1
- . S:OOPS(2260,DA,33,"E")="Yes" LTILL=LTILL+1
- S:INC=0 OOPS(2260,DA,1,"E")="",OOPS(2260,DA,15,"E")="",OOPS(2260,DA,14,"E")=""
- I 'HDRFLG D HDR S HDRFLG=1
- W !,CASE,?12,$P(OOPS(2260,DA,4,"E"),"@",1),?26,OOPS(2260,DA,1,"E")
- W ?58,OOPS(2260,DA,15,"E"),?64,$E(OOPS(2260,DA,14,"E"),1,4)
- W ?70,OOPS(2260,DA,33,"E") D P Q:EX=U
- W !,$E(OOPS(2260,DA,52,"E"),1,7),?12,$E(OOPS(2260,DA,51,"E"),1,12)
- W ?26,OOPS(2260,DA,3,"E") D P Q:EX=U
- I OOPS(2260,DA,86,"I")'="" W ?58,$E($$GET1^DIQ(49,OOPS(2260,DA,86,"I"),.01),1,22) D P Q:EX=U
- W !,$E(OOPS(2260,DA,29,"E"),1,35),?58,$E(OOPS(2260,DA,30,"E"),1,21) D P Q:EX=U
- ; patch 11 - if NS then print new prompts
- I $G(NS) D Q:EX=U
- . W ! I $G(OOPS(2260,DA,37,"I"))'="" W $$GET1^DIQ(2261.6,OOPS(2260,DA,37,"I"),.01) D P Q:EX=U
- . ; patch 11 v3 08/03/01
- . W !,$$GET1^DIQ(2260,DA,"38:.01") D P Q:EX=U
- . W !,$$GET1^DIQ(2260,DA,"82:.01") D P Q:EX=U
- . W !,$$GET1^DIQ(2260,DA,108) D P Q:EX=U
- . S OPFLD=28 D WP K OPFLD
- W !,DASHES
- Q
- LOGSUM ;Log Summary
- Q:EX=U
- ; Patch 9 - if nothing to summarize, don't print
- I 'INJ&('ILL)&('FCINJ)&('FCILL)&('LTINJ)&('LTILL) Q
- I IOST?1"C".E,$Y>14 D Q:EX=U
- .W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
- .W @IOF S PG=PG+1
- .W !,HDR,?72,"Page",$S($L(PG)=2:" ",1:" "),PG
- .W !?(40-($L(RANGE)/2)),RANGE
- .W !,DASHES
- W !,"Log Summary" D P Q:EX=U
- W !,DASHES D P Q:EX=U
- W !,"Injuries.: ",$J(INJ,3),?16,"Fatal Injuries....: ",$J(FCINJ,3)
- W ?41,"Lost Time Injuries....: ",$J(LTINJ,3) D P Q:EX=U
- W !,"Illnesses: ",$J(ILL,3),?16,"Fatal Illnesses...: ",$J(FCILL,3)
- W ?41,"Lost Time Illnesses...: ",$J(LTILL,3) D P Q:EX=U
- W !,"--------------",?16,"-----------------------",?41,"---------------------------" D P Q:EX=U
- S INJILL=INJ+ILL,FCINJILL=FCINJ+FCILL,LTINJILL=LTINJ+LTILL
- W !,"Total....: ",$J(INJILL,3),?16,"Total.............: ",$J(FCINJILL,3)
- W ?41,"Total.................: ",$J(LTINJILL,3)
- W !,DASHES
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
- S (INJ,FCINJ,LTINJ,ILL,FCILL,LTILL,INJILL,FCINJILL,LTINJILL)=0
- Q
- P ;Display Data
- I $Y'<LIN D Q:EX=U
- .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
- .D HDR
- Q
- TASK ;Queue a task
- K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
- S ZTRTN="PRT^OOPSLOG",ZTREQ="@",ZTSAVE("ZTREQ")=""
- S ZTDESC="Log of Federal Occupational Injuries and Illnesses"
- S ZTSAVE("FY")="",ZTSAVE("INC")="",ZTSAVE("NS")="",ZTSAVE("EV")=""
- ; Patch 5 - added STA
- S ZTSAVE("STA")=""
- ; Patch 11 - Added date Ranges
- S ZTSAVE("SD")="",ZTSAVE("SDT")="",ZTSAVE("ED")="",ZTSAVE("EDT")=""
- ; patch 11 v3 8/2/01 add new variables
- S ZTSAVE("RANGE")="",ZTSAVE("HDR")="",ZTSAVE("HDR1")=""
- S ZTSAVE("HDR2")=""
- D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
- K ZTSK Q
- HDR ;Header
- S HDR2="Station Name: "_$$GET1^DIQ(4,LP1,.01,"E")
- W @IOF S PG=PG+1
- W !?(40-($L(HDR)/2)),HDR,?72,"Page",$S($L(PG)=2:" ",1:" "),PG
- W !?(40-($L(RANGE)/2)),RANGE
- W !?(40-($L(HDR1)/2)),HDR1,!?(40-($L(HDR2)/2)),HDR2,!
- W:INC=1 !,"Case #",?12,"Date",?26,"Name",?58,"Occ",?64,"CC",?69,"Lost Time"
- W:INC=0 !,"Case #",?12,"Date",?69,"Lost Time"
- W !,"Inj/Ill",?12,"Status",?26,"Type of Incident",?58,"Service"
- W !,"Char. of Injury",?58,"Body Part Affected"
- I $G(NS) D
- . W !,"Activity at time of Injury"
- . ; Patch 11 v3 08/02/01
- . W !,"Object Causing Injury"
- . W !,"Model and Brand of Object Causing Injury"
- . W !,"Location of Injury"
- . ; W !,"Description of Injury"
- W !,DASHES
- Q
- STATION(STA,OUT) ; Get 'ALL' or one station
- S STA=""
- N DIC,DIR,DIRUT,Y
- S DIR(0)="Y",DIR("A")="Run report for 'ALL' Stations",DIR("B")="Yes"
- S DIR("?")="Enter 'Y'es to run for all Stations or 'N'o to run "
- S DIR("?")=DIR("?")_"for just one Station."
- D ^DIR I Y S STA="A" Q
- I $D(DIRUT)!($D(DUOUT)) S OUT=1 Q
- S1 ; if get here user <CR>
- S DIC("A")="Select STATION NUMBER: "
- S DIC="^DIC(4,",DIC(0)="AEMQZ"
- D ^DIC
- I $D(DUOUT) S OUT=1 Q
- I Y=-1 W !?5,"No Station selected, report will not run" S OUT=1 Q
- S STA=+Y
- I '$D(^OOPS(2260,"D",STA)) W !?5,"No data for that Station Number, Please select again." G S1
- Q
- WP ;Process Word Processing Fields
- N DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC
- K ^UTILITY($J,"W")
- S DIWL=1,DIWR="",DIWF="|C76"
- S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
- S OPI=0 F S OPI=$O(^OOPS(2260,DA,OPNODE,OPI)) Q:'OPI S X=$G(^OOPS(2260,DA,OPNODE,OPI,0)) D:X]"" ^DIWP
- S OPT=$G(^UTILITY($J,"W",1))+0
- I OPT D
- . W !,"Description of Injury:"
- . S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI!(EX=U) D
- .. W !?2,^UTILITY($J,"W",1,OPI,0) D P Q:EX=U
- K ^UTILITY($J,"W"),X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSLOG 7595 printed Feb 18, 2025@23:05:38 Page 2
- OOPSLOG ;HINES CIOFO/GB-Log of Federal Occupational Injuries and Illnesses ;8/15/96
- +1 ;;2.0;ASISTS;;Jun 03, 2002
- +2 NEW CN,CL,DA,DASHES,DATE,EX,FCILL,FCINJ,FCINJILL,FYR,FY,HDR,HDR1,HDR2
- +3 NEW HDRFLG,ILL,INC,INJ,INJILL,LIN,LP1,LTILL,LTINJ,LTINJILL,LYR,OUT,PG,STA
- +4 NEW RANGE
- SDED NEW DIR,DIRUT,DUOUT,X,Y,SD,ED,SDT,EDT
- +1 SET DIR(0)="D^2981001:DT:EX"
- +2 SET DIR("A")="Starting Date for the Report"
- +3 SET DIR("?")="Select a Starting Date from the range displayed."
- +4 DO ^DIR
- +5 if $DATA(DIRUT)
- GOTO EXIT
- +6 SET SD=Y
- SET SDT=Y(0)
- +7 KILL DIR,DIRUT,DUOUT,X,Y
- SET DIR(0)="D^2981001:DT:EX"
- +8 SET DIR("A")="Ending Date for the Report"
- +9 SET DIR("?")="Select a Ending Date from the range displayed"
- +10 DO ^DIR
- +11 if $DATA(DIRUT)
- GOTO EXIT
- +12 SET ED=Y
- SET EDT=Y(0)
- +13 IF $$FMDIFF^XLFDT(ED,SD,1)'>0
- WRITE !?5,"The Ending Date cannot be before or on the Starting Date, please re-enter this data."
- GOTO SDED
- +14 SET RANGE="for Period "_SDT_" - "_EDT
- +15 IF $DATA(EV)
- SET INC=0
- SET HDR1="Employees and volunteers only"
- GOTO PREDEV
- +16 KILL DIR
- SET DIR(0)="SA^E/V:Employees and volunteers only;A:All cases"
- SET DIR("A")="Cases to be included: "
- DO ^DIR
- KILL DIR
- +17 if $DATA(DIRUT)
- GOTO EXIT
- +18 SET EV=Y
- +19 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Include names of persons involved"
- SET DIR("B")="Yes"
- DO ^DIR
- KILL DIR
- +20 if $DATA(DIRUT)
- GOTO EXIT
- +21 SET INC=Y
- +22 ; Patch 5 -Get Station Number
- PREDEV SET OUT=""
- +1 DO STATION(.STA,.OUT)
- +2 if $DATA(DIRUT)!(OUT)
- GOTO EXIT
- DEV KILL IOP,%ZIS
- SET %ZIS="MQ"
- WRITE !
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO EXIT
- +1 IF $DATA(IO("Q"))
- DO TASK
- GOTO EXIT
- +2 USE IO
- DO PRT
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO EXIT
- PRT SET PG=0
- +1 SET (INJ,ILL,FCINJ,FCILL,LTINJ,LTILL)=0
- +2 ; was 5 and 6
- SET EX=""
- SET LIN=$SELECT(IOST?1"C".E:IOSL-4,1:IOSL-5)
- +3 KILL DASHES
- SET $PIECE(DASHES,"-",80)="-"
- +4 DO NOW^%DTC
- SET DATE=%
- SET Y=DATE
- XECUTE ^DD("DD")
- SET DATE=Y
- +5 SET HDR=$SELECT($GET(NS):"Log of Needlestick Incidents ",1:"Log of Federal Occupational Injuries and Illnesses ")
- +6 SET HDR1=$SELECT(EV="E/V":"Employees and volunteers only",1:"All cases")
- +7 ; Patch 5 - change for Station Number looping
- +8 SET LP1=""
- +9 IF STA="A"
- Begin DoDot:1
- +10 FOR
- SET LP1=$ORDER(^OOPS(2260,"D",LP1))
- if LP1=""!(EX=U)
- QUIT
- SET HDRFLG=0
- Begin DoDot:2
- +11 SET DA=0
- FOR
- SET DA=$ORDER(^OOPS(2260,"D",LP1,DA))
- if DA=""
- DO LOGSUM
- if DA=""!(EX=U)
- QUIT
- DO DATA
- End DoDot:2
- End DoDot:1
- GOTO EXIT
- +12 IF STA'="A"
- Begin DoDot:1
- +13 SET LP1=STA
- SET HDRFLG=0
- +14 SET DA=0
- FOR
- SET DA=$ORDER(^OOPS(2260,"D",LP1,DA))
- if DA=""
- DO LOGSUM
- if DA=""!(EX=U)
- QUIT
- DO DATA
- End DoDot:1
- GOTO EXIT
- EXIT ; Clean up and exit
- +1 KILL POP,X,Y,%,NS,EV
- +2 QUIT
- DATA ;
- +1 NEW CASE,OOPS,YR,DIC,DIQ,DR,CD
- +2 SET CASE=$$GET1^DIQ(2260,DA,.01)
- +3 SET YR=$EXTRACT(CASE,1,4)
- +4 SET CD=($PIECE(^OOPS(2260,DA,0),"^",5))\1
- +5 IF ($$FMDIFF^XLFDT(CD,SD,1)<0)!($$FMDIFF^XLFDT(CD,ED,1)>0)
- QUIT
- +6 KILL OOPS
- +7 SET DIC="^OOPS(2260,"
- +8 SET DR=".01;2;3;4;1;15;14;29;30;33;37;51;52;82;83;84;85;86"
- +9 SET DIQ="OOPS"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +10 IF $GET(NS)
- IF OOPS(2260,DA,3,"I")<11
- QUIT
- +11 IF EV="E/V"
- IF "1,2,6,"'[OOPS(2260,DA,2,"I")_","
- QUIT
- +12 if OOPS(2260,DA,51,"E")="Deleted"
- QUIT
- +13 if OOPS(2260,DA,51,"E")="Replaced by amendment"
- QUIT
- +14 ; Patch 9 fix summary logic
- +15 IF OOPS(2260,DA,52,"E")="Injury"
- SET INJ=INJ+1
- Begin DoDot:1
- +16 if OOPS(2260,DA,29,"E")="Death"
- SET FCINJ=FCINJ+1
- +17 if OOPS(2260,DA,33,"E")="Yes"
- SET LTINJ=LTINJ+1
- End DoDot:1
- +18 IF OOPS(2260,DA,52,"E")="Illness/disease"
- SET ILL=ILL+1
- Begin DoDot:1
- +19 if OOPS(2260,DA,29,"E")="Death"
- SET FCILL=FCILL+1
- +20 if OOPS(2260,DA,33,"E")="Yes"
- SET LTILL=LTILL+1
- End DoDot:1
- +21 if INC=0
- SET OOPS(2260,DA,1,"E")=""
- SET OOPS(2260,DA,15,"E")=""
- SET OOPS(2260,DA,14,"E")=""
- +22 IF 'HDRFLG
- DO HDR
- SET HDRFLG=1
- +23 WRITE !,CASE,?12,$PIECE(OOPS(2260,DA,4,"E"),"@",1),?26,OOPS(2260,DA,1,"E")
- +24 WRITE ?58,OOPS(2260,DA,15,"E"),?64,$EXTRACT(OOPS(2260,DA,14,"E"),1,4)
- +25 WRITE ?70,OOPS(2260,DA,33,"E")
- DO P
- if EX=U
- QUIT
- +26 WRITE !,$EXTRACT(OOPS(2260,DA,52,"E"),1,7),?12,$EXTRACT(OOPS(2260,DA,51,"E"),1,12)
- +27 WRITE ?26,OOPS(2260,DA,3,"E")
- DO P
- if EX=U
- QUIT
- +28 IF OOPS(2260,DA,86,"I")'=""
- WRITE ?58,$EXTRACT($$GET1^DIQ(49,OOPS(2260,DA,86,"I"),.01),1,22)
- DO P
- if EX=U
- QUIT
- +29 WRITE !,$EXTRACT(OOPS(2260,DA,29,"E"),1,35),?58,$EXTRACT(OOPS(2260,DA,30,"E"),1,21)
- DO P
- if EX=U
- QUIT
- +30 ; patch 11 - if NS then print new prompts
- +31 IF $GET(NS)
- Begin DoDot:1
- +32 WRITE !
- IF $GET(OOPS(2260,DA,37,"I"))'=""
- WRITE $$GET1^DIQ(2261.6,OOPS(2260,DA,37,"I"),.01)
- DO P
- if EX=U
- QUIT
- +33 ; patch 11 v3 08/03/01
- +34 WRITE !,$$GET1^DIQ(2260,DA,"38:.01")
- DO P
- if EX=U
- QUIT
- +35 WRITE !,$$GET1^DIQ(2260,DA,"82:.01")
- DO P
- if EX=U
- QUIT
- +36 WRITE !,$$GET1^DIQ(2260,DA,108)
- DO P
- if EX=U
- QUIT
- +37 SET OPFLD=28
- DO WP
- KILL OPFLD
- End DoDot:1
- if EX=U
- QUIT
- +38 WRITE !,DASHES
- +39 QUIT
- LOGSUM ;Log Summary
- +1 if EX=U
- QUIT
- +2 ; Patch 9 - if nothing to summarize, don't print
- +3 IF 'INJ&('ILL)&('FCINJ)&('FCILL)&('LTINJ)&('LTILL)
- QUIT
- +4 IF IOST?1"C".E
- IF $Y>14
- Begin DoDot:1
- +5 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET EX=U
- QUIT
- +6 WRITE @IOF
- SET PG=PG+1
- +7 WRITE !,HDR,?72,"Page",$SELECT($LENGTH(PG)=2:" ",1:" "),PG
- +8 WRITE !?(40-($LENGTH(RANGE)/2)),RANGE
- +9 WRITE !,DASHES
- End DoDot:1
- if EX=U
- QUIT
- +10 WRITE !,"Log Summary"
- DO P
- if EX=U
- QUIT
- +11 WRITE !,DASHES
- DO P
- if EX=U
- QUIT
- +12 WRITE !,"Injuries.: ",$JUSTIFY(INJ,3),?16,"Fatal Injuries....: ",$JUSTIFY(FCINJ,3)
- +13 WRITE ?41,"Lost Time Injuries....: ",$JUSTIFY(LTINJ,3)
- DO P
- if EX=U
- QUIT
- +14 WRITE !,"Illnesses: ",$JUSTIFY(ILL,3),?16,"Fatal Illnesses...: ",$JUSTIFY(FCILL,3)
- +15 WRITE ?41,"Lost Time Illnesses...: ",$JUSTIFY(LTILL,3)
- DO P
- if EX=U
- QUIT
- +16 WRITE !,"--------------",?16,"-----------------------",?41,"---------------------------"
- DO P
- if EX=U
- QUIT
- +17 SET INJILL=INJ+ILL
- SET FCINJILL=FCINJ+FCILL
- SET LTINJILL=LTINJ+LTILL
- +18 WRITE !,"Total....: ",$JUSTIFY(INJILL,3),?16,"Total.............: ",$JUSTIFY(FCINJILL,3)
- +19 WRITE ?41,"Total.................: ",$JUSTIFY(LTINJILL,3)
- +20 WRITE !,DASHES
- +21 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET EX=U
- QUIT
- +22 SET (INJ,FCINJ,LTINJ,ILL,FCILL,LTILL,INJILL,FCINJILL,LTINJILL)=0
- +23 QUIT
- P ;Display Data
- +1 IF $Y'<LIN
- Begin DoDot:1
- +2 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET EX=U
- QUIT
- +3 DO HDR
- End DoDot:1
- if EX=U
- QUIT
- +4 QUIT
- TASK ;Queue a task
- +1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
- +2 SET ZTRTN="PRT^OOPSLOG"
- SET ZTREQ="@"
- SET ZTSAVE("ZTREQ")=""
- +3 SET ZTDESC="Log of Federal Occupational Injuries and Illnesses"
- +4 SET ZTSAVE("FY")=""
- SET ZTSAVE("INC")=""
- SET ZTSAVE("NS")=""
- SET ZTSAVE("EV")=""
- +5 ; Patch 5 - added STA
- +6 SET ZTSAVE("STA")=""
- +7 ; Patch 11 - Added date Ranges
- +8 SET ZTSAVE("SD")=""
- SET ZTSAVE("SDT")=""
- SET ZTSAVE("ED")=""
- SET ZTSAVE("EDT")=""
- +9 ; patch 11 v3 8/2/01 add new variables
- +10 SET ZTSAVE("RANGE")=""
- SET ZTSAVE("HDR")=""
- SET ZTSAVE("HDR1")=""
- +11 SET ZTSAVE("HDR2")=""
- +12 DO ^%ZTLOAD
- DO ^%ZISC
- USE IO
- WRITE !,"Request Queued",!
- +13 KILL ZTSK
- QUIT
- HDR ;Header
- +1 SET HDR2="Station Name: "_$$GET1^DIQ(4,LP1,.01,"E")
- +2 WRITE @IOF
- SET PG=PG+1
- +3 WRITE !?(40-($LENGTH(HDR)/2)),HDR,?72,"Page",$SELECT($LENGTH(PG)=2:" ",1:" "),PG
- +4 WRITE !?(40-($LENGTH(RANGE)/2)),RANGE
- +5 WRITE !?(40-($LENGTH(HDR1)/2)),HDR1,!?(40-($LENGTH(HDR2)/2)),HDR2,!
- +6 if INC=1
- WRITE !,"Case #",?12,"Date",?26,"Name",?58,"Occ",?64,"CC",?69,"Lost Time"
- +7 if INC=0
- WRITE !,"Case #",?12,"Date",?69,"Lost Time"
- +8 WRITE !,"Inj/Ill",?12,"Status",?26,"Type of Incident",?58,"Service"
- +9 WRITE !,"Char. of Injury",?58,"Body Part Affected"
- +10 IF $GET(NS)
- Begin DoDot:1
- +11 WRITE !,"Activity at time of Injury"
- +12 ; Patch 11 v3 08/02/01
- +13 WRITE !,"Object Causing Injury"
- +14 WRITE !,"Model and Brand of Object Causing Injury"
- +15 WRITE !,"Location of Injury"
- +16 ; W !,"Description of Injury"
- End DoDot:1
- +17 WRITE !,DASHES
- +18 QUIT
- STATION(STA,OUT) ; Get 'ALL' or one station
- +1 SET STA=""
- +2 NEW DIC,DIR,DIRUT,Y
- +3 SET DIR(0)="Y"
- SET DIR("A")="Run report for 'ALL' Stations"
- SET DIR("B")="Yes"
- +4 SET DIR("?")="Enter 'Y'es to run for all Stations or 'N'o to run "
- +5 SET DIR("?")=DIR("?")_"for just one Station."
- +6 DO ^DIR
- IF Y
- SET STA="A"
- QUIT
- +7 IF $DATA(DIRUT)!($DATA(DUOUT))
- SET OUT=1
- QUIT
- S1 ; if get here user <CR>
- +1 SET DIC("A")="Select STATION NUMBER: "
- +2 SET DIC="^DIC(4,"
- SET DIC(0)="AEMQZ"
- +3 DO ^DIC
- +4 IF $DATA(DUOUT)
- SET OUT=1
- QUIT
- +5 IF Y=-1
- WRITE !?5,"No Station selected, report will not run"
- SET OUT=1
- QUIT
- +6 SET STA=+Y
- +7 IF '$DATA(^OOPS(2260,"D",STA))
- WRITE !?5,"No data for that Station Number, Please select again."
- GOTO S1
- +8 QUIT
- WP ;Process Word Processing Fields
- +1 NEW DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC
- +2 KILL ^UTILITY($JOB,"W")
- +3 SET DIWL=1
- SET DIWR=""
- SET DIWF="|C76"
- +4 SET OPNODE=$PIECE($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
- +5 SET OPI=0
- FOR
- SET OPI=$ORDER(^OOPS(2260,DA,OPNODE,OPI))
- if 'OPI
- QUIT
- SET X=$GET(^OOPS(2260,DA,OPNODE,OPI,0))
- if X]""
- DO ^DIWP
- +6 SET OPT=$GET(^UTILITY($JOB,"W",1))+0
- +7 IF OPT
- Begin DoDot:1
- +8 WRITE !,"Description of Injury:"
- +9 SET OPI=0
- FOR OPC=1:1
- SET OPI=$ORDER(^UTILITY($JOB,"W",1,OPI))
- if 'OPI!(EX=U)
- QUIT
- Begin DoDot:2
- +10 WRITE !?2,^UTILITY($JOB,"W",1,OPI,0)
- DO P
- if EX=U
- QUIT
- End DoDot:2
- End DoDot:1
- +11 KILL ^UTILITY($JOB,"W"),X
- +12 QUIT
