source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSLOG.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1OOPSLOG ;HINES CIOFO/GB-Log of Federal Occupational Injuries and Illnesses ;8/15/96
2 ;;2.0;ASISTS;;Jun 03, 2002
3 N CN,CL,DA,DASHES,DATE,EX,FCILL,FCINJ,FCINJILL,FYR,FY,HDR,HDR1,HDR2
4 N HDRFLG,ILL,INC,INJ,INJILL,LIN,LP1,LTILL,LTINJ,LTINJILL,LYR,OUT,PG,STA
5 N RANGE
6SDED N DIR,DIRUT,DUOUT,X,Y,SD,ED,SDT,EDT
7 S DIR(0)="D^2981001:DT:EX"
8 S DIR("A")="Starting Date for the Report"
9 S DIR("?")="Select a Starting Date from the range displayed."
10 D ^DIR
11 G:$D(DIRUT) EXIT
12 S SD=Y,SDT=Y(0)
13 K DIR,DIRUT,DUOUT,X,Y S DIR(0)="D^2981001:DT:EX"
14 S DIR("A")="Ending Date for the Report"
15 S DIR("?")="Select a Ending Date from the range displayed"
16 D ^DIR
17 G:$D(DIRUT) EXIT
18 S ED=Y,EDT=Y(0)
19 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
20 S RANGE="for Period "_SDT_" - "_EDT
21 I $D(EV) S INC=0,HDR1="Employees and volunteers only" G PREDEV
22 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
23 G:$D(DIRUT) EXIT
24 S EV=Y
25 K DIR S DIR(0)="Y",DIR("A")="Include names of persons involved",DIR("B")="Yes" D ^DIR K DIR
26 G:$D(DIRUT) EXIT
27 S INC=Y
28 ; Patch 5 -Get Station Number
29PREDEV S OUT=""
30 D STATION(.STA,.OUT)
31 G:$D(DIRUT)!(OUT) EXIT
32DEV K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP EXIT
33 I $D(IO("Q")) D TASK G EXIT
34 U IO D PRT D ^%ZISC K %ZIS,IOP G EXIT
35PRT S PG=0
36 S (INJ,ILL,FCINJ,FCILL,LTINJ,LTILL)=0
37 S EX="",LIN=$S(IOST?1"C".E:IOSL-4,1:IOSL-5) ; was 5 and 6
38 K DASHES S $P(DASHES,"-",80)="-"
39 D NOW^%DTC S DATE=%,Y=DATE X ^DD("DD") S DATE=Y
40 S HDR=$S($G(NS):"Log of Needlestick Incidents ",1:"Log of Federal Occupational Injuries and Illnesses ")
41 S HDR1=$S(EV="E/V":"Employees and volunteers only",1:"All cases")
42 ; Patch 5 - change for Station Number looping
43 S LP1=""
44 I STA="A" D G EXIT
45 . F S LP1=$O(^OOPS(2260,"D",LP1)) Q:LP1=""!(EX=U) S HDRFLG=0 D
46 .. S DA=0 F S DA=$O(^OOPS(2260,"D",LP1,DA)) D:DA="" LOGSUM Q:DA=""!(EX=U) D DATA
47 I STA'="A" D G EXIT
48 . S LP1=STA,HDRFLG=0
49 . S DA=0 F S DA=$O(^OOPS(2260,"D",LP1,DA)) D:DA="" LOGSUM Q:DA=""!(EX=U) D DATA
50EXIT ; Clean up and exit
51 K POP,X,Y,%,NS,EV
52 Q
53DATA ;
54 N CASE,OOPS,YR,DIC,DIQ,DR,CD
55 S CASE=$$GET1^DIQ(2260,DA,.01)
56 S YR=$E(CASE,1,4)
57 S CD=($P(^OOPS(2260,DA,0),"^",5))\1
58 I ($$FMDIFF^XLFDT(CD,SD,1)<0)!($$FMDIFF^XLFDT(CD,ED,1)>0) Q
59 K OOPS
60 S DIC="^OOPS(2260,"
61 S DR=".01;2;3;4;1;15;14;29;30;33;37;51;52;82;83;84;85;86"
62 S DIQ="OOPS",DIQ(0)="IE" D EN^DIQ1
63 I $G(NS),OOPS(2260,DA,3,"I")<11 Q
64 I EV="E/V","1,2,6,"'[OOPS(2260,DA,2,"I")_"," Q
65 Q:OOPS(2260,DA,51,"E")="Deleted"
66 Q:OOPS(2260,DA,51,"E")="Replaced by amendment"
67 ; Patch 9 fix summary logic
68 I OOPS(2260,DA,52,"E")="Injury" S INJ=INJ+1 D
69 . S:OOPS(2260,DA,29,"E")="Death" FCINJ=FCINJ+1
70 . S:OOPS(2260,DA,33,"E")="Yes" LTINJ=LTINJ+1
71 I OOPS(2260,DA,52,"E")="Illness/disease" S ILL=ILL+1 D
72 . S:OOPS(2260,DA,29,"E")="Death" FCILL=FCILL+1
73 . S:OOPS(2260,DA,33,"E")="Yes" LTILL=LTILL+1
74 S:INC=0 OOPS(2260,DA,1,"E")="",OOPS(2260,DA,15,"E")="",OOPS(2260,DA,14,"E")=""
75 I 'HDRFLG D HDR S HDRFLG=1
76 W !,CASE,?12,$P(OOPS(2260,DA,4,"E"),"@",1),?26,OOPS(2260,DA,1,"E")
77 W ?58,OOPS(2260,DA,15,"E"),?64,$E(OOPS(2260,DA,14,"E"),1,4)
78 W ?70,OOPS(2260,DA,33,"E") D P Q:EX=U
79 W !,$E(OOPS(2260,DA,52,"E"),1,7),?12,$E(OOPS(2260,DA,51,"E"),1,12)
80 W ?26,OOPS(2260,DA,3,"E") D P Q:EX=U
81 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
82 W !,$E(OOPS(2260,DA,29,"E"),1,35),?58,$E(OOPS(2260,DA,30,"E"),1,21) D P Q:EX=U
83 ; patch 11 - if NS then print new prompts
84 I $G(NS) D Q:EX=U
85 . W ! I $G(OOPS(2260,DA,37,"I"))'="" W $$GET1^DIQ(2261.6,OOPS(2260,DA,37,"I"),.01) D P Q:EX=U
86 . ; patch 11 v3 08/03/01
87 . W !,$$GET1^DIQ(2260,DA,"38:.01") D P Q:EX=U
88 . W !,$$GET1^DIQ(2260,DA,"82:.01") D P Q:EX=U
89 . W !,$$GET1^DIQ(2260,DA,108) D P Q:EX=U
90 . S OPFLD=28 D WP K OPFLD
91 W !,DASHES
92 Q
93LOGSUM ;Log Summary
94 Q:EX=U
95 ; Patch 9 - if nothing to summarize, don't print
96 I 'INJ&('ILL)&('FCINJ)&('FCILL)&('LTINJ)&('LTILL) Q
97 I IOST?1"C".E,$Y>14 D Q:EX=U
98 .W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
99 .W @IOF S PG=PG+1
100 .W !,HDR,?72,"Page",$S($L(PG)=2:" ",1:" "),PG
101 .W !?(40-($L(RANGE)/2)),RANGE
102 .W !,DASHES
103 W !,"Log Summary" D P Q:EX=U
104 W !,DASHES D P Q:EX=U
105 W !,"Injuries.: ",$J(INJ,3),?16,"Fatal Injuries....: ",$J(FCINJ,3)
106 W ?41,"Lost Time Injuries....: ",$J(LTINJ,3) D P Q:EX=U
107 W !,"Illnesses: ",$J(ILL,3),?16,"Fatal Illnesses...: ",$J(FCILL,3)
108 W ?41,"Lost Time Illnesses...: ",$J(LTILL,3) D P Q:EX=U
109 W !,"--------------",?16,"-----------------------",?41,"---------------------------" D P Q:EX=U
110 S INJILL=INJ+ILL,FCINJILL=FCINJ+FCILL,LTINJILL=LTINJ+LTILL
111 W !,"Total....: ",$J(INJILL,3),?16,"Total.............: ",$J(FCINJILL,3)
112 W ?41,"Total.................: ",$J(LTINJILL,3)
113 W !,DASHES
114 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
115 S (INJ,FCINJ,LTINJ,ILL,FCILL,LTILL,INJILL,FCINJILL,LTINJILL)=0
116 Q
117P ;Display Data
118 I $Y'<LIN D Q:EX=U
119 .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
120 .D HDR
121 Q
122TASK ;Queue a task
123 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
124 S ZTRTN="PRT^OOPSLOG",ZTREQ="@",ZTSAVE("ZTREQ")=""
125 S ZTDESC="Log of Federal Occupational Injuries and Illnesses"
126 S ZTSAVE("FY")="",ZTSAVE("INC")="",ZTSAVE("NS")="",ZTSAVE("EV")=""
127 ; Patch 5 - added STA
128 S ZTSAVE("STA")=""
129 ; Patch 11 - Added date Ranges
130 S ZTSAVE("SD")="",ZTSAVE("SDT")="",ZTSAVE("ED")="",ZTSAVE("EDT")=""
131 ; patch 11 v3 8/2/01 add new variables
132 S ZTSAVE("RANGE")="",ZTSAVE("HDR")="",ZTSAVE("HDR1")=""
133 S ZTSAVE("HDR2")=""
134 D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
135 K ZTSK Q
136HDR ;Header
137 S HDR2="Station Name: "_$$GET1^DIQ(4,LP1,.01,"E")
138 W @IOF S PG=PG+1
139 W !?(40-($L(HDR)/2)),HDR,?72,"Page",$S($L(PG)=2:" ",1:" "),PG
140 W !?(40-($L(RANGE)/2)),RANGE
141 W !?(40-($L(HDR1)/2)),HDR1,!?(40-($L(HDR2)/2)),HDR2,!
142 W:INC=1 !,"Case #",?12,"Date",?26,"Name",?58,"Occ",?64,"CC",?69,"Lost Time"
143 W:INC=0 !,"Case #",?12,"Date",?69,"Lost Time"
144 W !,"Inj/Ill",?12,"Status",?26,"Type of Incident",?58,"Service"
145 W !,"Char. of Injury",?58,"Body Part Affected"
146 I $G(NS) D
147 . W !,"Activity at time of Injury"
148 . ; Patch 11 v3 08/02/01
149 . W !,"Object Causing Injury"
150 . W !,"Model and Brand of Object Causing Injury"
151 . W !,"Location of Injury"
152 . ; W !,"Description of Injury"
153 W !,DASHES
154 Q
155STATION(STA,OUT) ; Get 'ALL' or one station
156 S STA=""
157 N DIC,DIR,DIRUT,Y
158 S DIR(0)="Y",DIR("A")="Run report for 'ALL' Stations",DIR("B")="Yes"
159 S DIR("?")="Enter 'Y'es to run for all Stations or 'N'o to run "
160 S DIR("?")=DIR("?")_"for just one Station."
161 D ^DIR I Y S STA="A" Q
162 I $D(DIRUT)!($D(DUOUT)) S OUT=1 Q
163S1 ; if get here user <CR>
164 S DIC("A")="Select STATION NUMBER: "
165 S DIC="^DIC(4,",DIC(0)="AEMQZ"
166 D ^DIC
167 I $D(DUOUT) S OUT=1 Q
168 I Y=-1 W !?5,"No Station selected, report will not run" S OUT=1 Q
169 S STA=+Y
170 I '$D(^OOPS(2260,"D",STA)) W !?5,"No data for that Station Number, Please select again." G S1
171 Q
172WP ;Process Word Processing Fields
173 N DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC
174 K ^UTILITY($J,"W")
175 S DIWL=1,DIWR="",DIWF="|C76"
176 S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
177 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
178 S OPT=$G(^UTILITY($J,"W",1))+0
179 I OPT D
180 . W !,"Description of Injury:"
181 . S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI!(EX=U) D
182 .. W !?2,^UTILITY($J,"W",1,OPI,0) D P Q:EX=U
183 K ^UTILITY($J,"W"),X
184 Q
Note: See TracBrowser for help on using the repository browser.