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 May 14, 2023@14:06:10 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
