VistA-FOIAVistA/r/ASISTS-OOPS/OOPSLOG.m

185 lines
7.2 KiB
Mathematica

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