source: FOIAVistA/tag/r/ASISTS-OOPS/OOPSPRT1.m@ 1093

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

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1OOPSPRT1 ;HINES/WAA-Utilities Routines ;3/24/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4 ; This routine is to display all the report that a person has
5 ; access to.
6EN1(CALLER) ;
7 ; Input:
8 ; Caller O = Safety Officer
9 ; U = Union
10 ; S = Supervisor
11 ; E = Employee
12 ;
13 N YEAR,OUT,PAGE,STA,OUTPUT,SSN,HEAD
14 ; Patch 5 - added logic to print all stations or 1
15 S OUT=0,PAGE=1,OUTPUT=0
16 S YEAR=""
17 I CALLER="E" D
18 .S SSN=$P(^VA(200,DUZ,1),U,9)
19 .Q:$D(^OOPS(2260,"SSN",SSN))<1
20 .Q
21 D RANGE(.YEAR,.OUT)
22 I 'OUT D STATION(.STA,.OUT)
23 D:'OUT DEVICE
24 I 'OUT D:'$D(IO("Q")) PRINT
25EXIT ;
26 D ^%ZISC
27 S:$D(ZTQUEUED) ZTREQ="@"
28 K IO("Q")
29 Q
30RANGE(YEAR,OUT) ; This Subroutine will allow the user to select a range.
31 ; Output
32 ; YEAR = The year that the user what to print
33 ; = "" all years
34 ;
35 N DIR,DIRUT,Y
36R1 S DIR(0)="NAO^0:9999:0"
37 S DIR("A")="Select the Fiscal Year or RETURN for ALL: "
38 S DIR("??")="Enter the Fiscal Year that you want to print for or RETURN for data in file"
39 D ^DIR
40 I $D(DTOUT)!($D(DUOUT)) S OUT=1 Q
41 I Y'="",$L(Y)'=4 W !,"You must enter a 4 digit year." G R1
42 S YEAR=Y
43 I YEAR'="",'$O(^OOPS(2260,"B",(YEAR_"00000"))) W !,"No date for that Fiscal Year please select again." G R1
44 Q
45STATION(STA,OUT) ;
46 S STA=""
47 N DIC,DIR,DIRUT,Y
48 S DIR(0)="Y",DIR("A")="Run report for 'ALL' Stations",DIR("B")="Yes"
49 S DIR("?")="Enter 'Y'es to run for all Stations or 'N'o to run "
50 S DIR("?")=DIR("?")_"for just one Station."
51 D ^DIR I Y S STA="A" Q
52 I $D(DIRUT)!($D(DUOUT)) S OUT=1 Q
53S1 ; if get here user <CR>
54 S DIC("A")="Select STATION NUMBER: "
55 S DIC="^DIC(4,",DIC(0)="AEMQZ"
56 D ^DIC K DIC
57 I Y=-1 W !?5,"No Station selected, report will not run" S OUT=1 Q
58 S STA=+Y
59 I '$D(^OOPS(2260,"D",STA)) W !?5,"No data for that Station Number, Please select again." G S1
60 Q
61DEVICE ; This is the device selection routine.
62 ;
63 S %ZIS="QM" D ^%ZIS I POP S OUT=1 Q
64 I $D(IO("Q")) D Q
65 .S ZTRTN="PRINT^OOPSPRT1",ZTDESC="Print Accident Report Sign-off list"
66 .S ZTSAVE("YEAR")="",ZTSAVE("STA")="" ; Patch 5 - added STA
67 .S ZTSAVE("OUT")=""
68 .S ZTSAVE("CALLER")=""
69 .S ZTSAVE("SSN")=""
70 .S ZTSAVE("PAGE")=""
71 .S ZTSAVE("OUTPUT")=""
72 .D ^%ZTLOAD D HOME^%ZIS Q
73 .Q
74 Q
75PRINT ; This is the main print portion of the routine
76 N CNT,LOOP
77 S CNT=0
78 S LOOP=$S(STA="A":"",1:STA)
79 U IO
80 I STA'="A" D ONE Q
81MAIN ; Main Loop
82 F S LOOP=$O(^OOPS(2260,"D",LOOP)) Q:LOOP=""!OUT S HEAD=1 D:$D(^OOPS(2260,"D",LOOP)) HEAD Q:OUT D
83 . S IEN=0 F S IEN=$O(^OOPS(2260,"D",LOOP,IEN)) Q:IEN<1!OUT D DATA
84 Q
85ONE ; Only 1 Station Selected
86 I $D(^OOPS(2260,"D",LOOP)) D HEAD
87 S IEN=0 F S IEN=$O(^OOPS(2260,"D",LOOP,IEN)) Q:IEN<1!OUT D DATA
88 Q
89DATA ; Loop to get & print data
90 N CASE,NAME,SSN1,DATE,INC,CAT,YR
91 S CASE=$$GET1^DIQ(2260,IEN,.01)
92 S YR=$E(CASE,1,4)
93 I YEAR,YEAR'=YR Q
94 ; Only get OPEN cases - field 51 - 0 = OPEN
95 I $$GET1^DIQ(2260,IEN,51,"I") Q
96 S INC=$$GET1^DIQ(2260,IEN,52,"I")
97 S NAME=$E($$GET1^DIQ(2260,IEN,1,"E"),1,30)
98 S SSN1=$$GET1^DIQ(2260,IEN,5,"E")
99 S DATE=$$GET1^DIQ(2260,IEN,4,"E")
100 S CAT=$$GET1^DIQ(2260,IEN,2,"I")
101 S CNT=CNT+1
102 I CALLER="E" Q:SSN'=SSN1
103 I CALLER="S" I ($$GET1^DIQ(2260,IEN,53,"I")'=DUZ),($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ) Q
104 S OUTPUT=1
105 D HEAD Q:OUT
106 W !!,CASE
107 W:CALLER'="U" ?12,NAME,?42,SSN1
108 W ?57,DATE
109 W !,?35," CA1 ",?50," CA2 ",?65," 2162 "
110 W !,?35,"---------",?50,"---------",?65,"---------"
111 D ; Employee Data
112 . N SIGN
113 . S SIGN=$$EDSTA^OOPSUTL1(IEN,"E")
114 . W !,?20,"EMPLOYEE:"
115 . I INC=1 W ?35
116 . I INC=2 W ?50
117 . ; Also, not a Non-PAID Employee either
118 . ; Patch 5 - logic changed for new Personnel Categories
119 . I '$$ISEMP^OOPSUTL4(IEN) W "N/A(",$E($$GET1^DIQ(2260,IEN,2,"E"),1,7),")" Q
120 . W $S($P(SIGN,U,INC):" ",1:"UN-"),"SIGNED"
121 . Q
122 Q:CALLER="E"
123 D ; Supervisor Data
124 . N SIGN
125 . S SIGN=$$EDSTA^OOPSUTL1(IEN,"S")
126 . W !,?20,"SUPERVISOR:"
127 . I INC=1 W ?35
128 . I INC=2 W ?50
129 .;Also not a Non-Paid Employee either
130 .; Patch 5 - See above
131 . I '$$ISEMP^OOPSUTL4(IEN) W "N/A(",$E($$GET1^DIQ(2260,IEN,2,"E"),1,7),")"
132 . E W $S($P(SIGN,U,INC):" ",1:"UN-"),"SIGNED"
133 . W ?65,$S($P(SIGN,U,3):" ",1:"UN-"),"SIGNED"
134 . Q
135 Q:CALLER="S"
136 D ; Safety Officer Data
137 . N SIGN
138 . S SIGN=$$EDSTA^OOPSUTL1(IEN,"O")
139 . W !,?20,"SAFETY OFFICER:"
140 . W ?65,$S($P(SIGN,U):" ",1:"UN-"),"SIGNED"
141 . Q
142 Q
143HEAD ; This is the head portion of the routine
144 I PAGE=1 D
145 .W:$E(IOST,1,2)="C-" @IOF
146 .Q
147 I PAGE'=1 Q:($Y<(IOSL-6)&('HEAD))
148 I $E(IOST,1,2)="C-" D Q:OUT
149 .I PAGE=1 W @IOF Q
150 .I PAGE'=1 D Q:OUT
151 ..N DIR S DIR(0)="E" D ^DIR I 'Y S OUT=1
152 ..K Y
153 ..Q
154 .Q
155 Q:OUT
156 I PAGE'=1 W @IOF
157 N LINER,TAB,LINE2,TAB2
158 W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"PAGE: ",PAGE,!
159 S LINER="Accident Report Status"_$S(YEAR="":"",1:" for the fiscal Year "_YEAR)
160 S TAB=(40-($L(LINER)/2))
161 S LINE2="Station Number: "_$$GET1^DIQ(4,LOOP,.01,"E")
162 S TAB2=(40-($L(LINE2)/2))
163 W ?TAB,LINER,!,?TAB2,LINE2
164 W !,"Case No."
165 W:CALLER'="U" ?12,"Name",?46,"SSN"
166 W ?57,"DATE OF INCIDENT"
167 W !,"============================================================================="
168 S PAGE=PAGE+1,HEAD=""
169 Q
Note: See TracBrowser for help on using the repository browser.