OOPSPRT1 ;HINES/WAA-Utilities Routines ;3/24/98
;;2.0;ASISTS;;Jun 03, 2002
;;
; This routine is to display all the report that a person has
; access to.
EN1(CALLER) ;
; Input:
; Caller O = Safety Officer
; U = Union
; S = Supervisor
; E = Employee
;
N YEAR,OUT,PAGE,STA,OUTPUT,SSN,HEAD
; Patch 5 - added logic to print all stations or 1
S OUT=0,PAGE=1,OUTPUT=0
S YEAR=""
I CALLER="E" D
.S SSN=$P(^VA(200,DUZ,1),U,9)
.Q:$D(^OOPS(2260,"SSN",SSN))<1
.Q
D RANGE(.YEAR,.OUT)
I 'OUT D STATION(.STA,.OUT)
D:'OUT DEVICE
I 'OUT D:'$D(IO("Q")) PRINT
EXIT ;
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
K IO("Q")
Q
RANGE(YEAR,OUT) ; This Subroutine will allow the user to select a range.
; Output
; YEAR = The year that the user what to print
; = "" all years
;
N DIR,DIRUT,Y
R1 S DIR(0)="NAO^0:9999:0"
S DIR("A")="Select the Fiscal Year or RETURN for ALL: "
S DIR("??")="Enter the Fiscal Year that you want to print for or RETURN for data in file"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S OUT=1 Q
I Y'="",$L(Y)'=4 W !,"You must enter a 4 digit year." G R1
S YEAR=Y
I YEAR'="",'$O(^OOPS(2260,"B",(YEAR_"00000"))) W !,"No date for that Fiscal Year please select again." G R1
Q
STATION(STA,OUT) ;
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 K DIC
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
DEVICE ; This is the device selection routine.
;
S %ZIS="QM" D ^%ZIS I POP S OUT=1 Q
I $D(IO("Q")) D Q
.S ZTRTN="PRINT^OOPSPRT1",ZTDESC="Print Accident Report Sign-off list"
.S ZTSAVE("YEAR")="",ZTSAVE("STA")="" ; Patch 5 - added STA
.S ZTSAVE("OUT")=""
.S ZTSAVE("CALLER")=""
.S ZTSAVE("SSN")=""
.S ZTSAVE("PAGE")=""
.S ZTSAVE("OUTPUT")=""
.D ^%ZTLOAD D HOME^%ZIS Q
.Q
Q
PRINT ; This is the main print portion of the routine
N CNT,LOOP
S CNT=0
S LOOP=$S(STA="A":"",1:STA)
U IO
I STA'="A" D ONE Q
MAIN ; Main Loop
F S LOOP=$O(^OOPS(2260,"D",LOOP)) Q:LOOP=""!OUT S HEAD=1 D:$D(^OOPS(2260,"D",LOOP)) HEAD Q:OUT D
. S IEN=0 F S IEN=$O(^OOPS(2260,"D",LOOP,IEN)) Q:IEN<1!OUT D DATA
Q
ONE ; Only 1 Station Selected
I $D(^OOPS(2260,"D",LOOP)) D HEAD
S IEN=0 F S IEN=$O(^OOPS(2260,"D",LOOP,IEN)) Q:IEN<1!OUT D DATA
Q
DATA ; Loop to get & print data
N CASE,NAME,SSN1,DATE,INC,CAT,YR
S CASE=$$GET1^DIQ(2260,IEN,.01)
S YR=$E(CASE,1,4)
I YEAR,YEAR'=YR Q
; Only get OPEN cases - field 51 - 0 = OPEN
I $$GET1^DIQ(2260,IEN,51,"I") Q
S INC=$$GET1^DIQ(2260,IEN,52,"I")
S NAME=$E($$GET1^DIQ(2260,IEN,1,"E"),1,30)
S SSN1=$$GET1^DIQ(2260,IEN,5,"E")
S DATE=$$GET1^DIQ(2260,IEN,4,"E")
S CAT=$$GET1^DIQ(2260,IEN,2,"I")
S CNT=CNT+1
I CALLER="E" Q:SSN'=SSN1
I CALLER="S" I ($$GET1^DIQ(2260,IEN,53,"I")'=DUZ),($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ) Q
S OUTPUT=1
D HEAD Q:OUT
W !!,CASE
W:CALLER'="U" ?12,NAME,?42,SSN1
W ?57,DATE
W !,?35," CA1 ",?50," CA2 ",?65," 2162 "
W !,?35,"---------",?50,"---------",?65,"---------"
D ; Employee Data
. N SIGN
. S SIGN=$$EDSTA^OOPSUTL1(IEN,"E")
. W !,?20,"EMPLOYEE:"
. I INC=1 W ?35
. I INC=2 W ?50
. ; Also, not a Non-PAID Employee either
. ; Patch 5 - logic changed for new Personnel Categories
. I '$$ISEMP^OOPSUTL4(IEN) W "N/A(",$E($$GET1^DIQ(2260,IEN,2,"E"),1,7),")" Q
. W $S($P(SIGN,U,INC):" ",1:"UN-"),"SIGNED"
. Q
Q:CALLER="E"
D ; Supervisor Data
. N SIGN
. S SIGN=$$EDSTA^OOPSUTL1(IEN,"S")
. W !,?20,"SUPERVISOR:"
. I INC=1 W ?35
. I INC=2 W ?50
.;Also not a Non-Paid Employee either
.; Patch 5 - See above
. I '$$ISEMP^OOPSUTL4(IEN) W "N/A(",$E($$GET1^DIQ(2260,IEN,2,"E"),1,7),")"
. E W $S($P(SIGN,U,INC):" ",1:"UN-"),"SIGNED"
. W ?65,$S($P(SIGN,U,3):" ",1:"UN-"),"SIGNED"
. Q
Q:CALLER="S"
D ; Safety Officer Data
. N SIGN
. S SIGN=$$EDSTA^OOPSUTL1(IEN,"O")
. W !,?20,"SAFETY OFFICER:"
. W ?65,$S($P(SIGN,U):" ",1:"UN-"),"SIGNED"
. Q
Q
HEAD ; This is the head portion of the routine
I PAGE=1 D
.W:$E(IOST,1,2)="C-" @IOF
.Q
I PAGE'=1 Q:($Y<(IOSL-6)&('HEAD))
I $E(IOST,1,2)="C-" D Q:OUT
.I PAGE=1 W @IOF Q
.I PAGE'=1 D Q:OUT
..N DIR S DIR(0)="E" D ^DIR I 'Y S OUT=1
..K Y
..Q
.Q
Q:OUT
I PAGE'=1 W @IOF
N LINER,TAB,LINE2,TAB2
W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"PAGE: ",PAGE,!
S LINER="Accident Report Status"_$S(YEAR="":"",1:" for the fiscal Year "_YEAR)
S TAB=(40-($L(LINER)/2))
S LINE2="Station Number: "_$$GET1^DIQ(4,LOOP,.01,"E")
S TAB2=(40-($L(LINE2)/2))
W ?TAB,LINER,!,?TAB2,LINE2
W !,"Case No."
W:CALLER'="U" ?12,"Name",?46,"SSN"
W ?57,"DATE OF INCIDENT"
W !,"============================================================================="
S PAGE=PAGE+1,HEAD=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSPRT1 5215 printed Nov 22, 2024@16:49:48 Page 2
OOPSPRT1 ;HINES/WAA-Utilities Routines ;3/24/98
+1 ;;2.0;ASISTS;;Jun 03, 2002
+2 ;;
+3 ; This routine is to display all the report that a person has
+4 ; access to.
EN1(CALLER) ;
+1 ; Input:
+2 ; Caller O = Safety Officer
+3 ; U = Union
+4 ; S = Supervisor
+5 ; E = Employee
+6 ;
+7 NEW YEAR,OUT,PAGE,STA,OUTPUT,SSN,HEAD
+8 ; Patch 5 - added logic to print all stations or 1
+9 SET OUT=0
SET PAGE=1
SET OUTPUT=0
+10 SET YEAR=""
+11 IF CALLER="E"
Begin DoDot:1
+12 SET SSN=$PIECE(^VA(200,DUZ,1),U,9)
+13 if $DATA(^OOPS(2260,"SSN",SSN))<1
QUIT
+14 QUIT
End DoDot:1
+15 DO RANGE(.YEAR,.OUT)
+16 IF 'OUT
DO STATION(.STA,.OUT)
+17 if 'OUT
DO DEVICE
+18 IF 'OUT
if '$DATA(IO("Q"))
DO PRINT
EXIT ;
+1 DO ^%ZISC
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL IO("Q")
+4 QUIT
RANGE(YEAR,OUT) ; This Subroutine will allow the user to select a range.
+1 ; Output
+2 ; YEAR = The year that the user what to print
+3 ; = "" all years
+4 ;
+5 NEW DIR,DIRUT,Y
R1 SET DIR(0)="NAO^0:9999:0"
+1 SET DIR("A")="Select the Fiscal Year or RETURN for ALL: "
+2 SET DIR("??")="Enter the Fiscal Year that you want to print for or RETURN for data in file"
+3 DO ^DIR
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
SET OUT=1
QUIT
+5 IF Y'=""
IF $LENGTH(Y)'=4
WRITE !,"You must enter a 4 digit year."
GOTO R1
+6 SET YEAR=Y
+7 IF YEAR'=""
IF '$ORDER(^OOPS(2260,"B",(YEAR_"00000")))
WRITE !,"No date for that Fiscal Year please select again."
GOTO R1
+8 QUIT
STATION(STA,OUT) ;
+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
KILL DIC
+4 IF Y=-1
WRITE !?5,"No Station selected, report will not run"
SET OUT=1
QUIT
+5 SET STA=+Y
+6 IF '$DATA(^OOPS(2260,"D",STA))
WRITE !?5,"No data for that Station Number, Please select again."
GOTO S1
+7 QUIT
DEVICE ; This is the device selection routine.
+1 ;
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
SET OUT=1
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="PRINT^OOPSPRT1"
SET ZTDESC="Print Accident Report Sign-off list"
+5 ; Patch 5 - added STA
SET ZTSAVE("YEAR")=""
SET ZTSAVE("STA")=""
+6 SET ZTSAVE("OUT")=""
+7 SET ZTSAVE("CALLER")=""
+8 SET ZTSAVE("SSN")=""
+9 SET ZTSAVE("PAGE")=""
+10 SET ZTSAVE("OUTPUT")=""
+11 DO ^%ZTLOAD
DO HOME^%ZIS
QUIT
+12 QUIT
End DoDot:1
QUIT
+13 QUIT
PRINT ; This is the main print portion of the routine
+1 NEW CNT,LOOP
+2 SET CNT=0
+3 SET LOOP=$SELECT(STA="A":"",1:STA)
+4 USE IO
+5 IF STA'="A"
DO ONE
QUIT
MAIN ; Main Loop
+1 FOR
SET LOOP=$ORDER(^OOPS(2260,"D",LOOP))
if LOOP=""!OUT
QUIT
SET HEAD=1
if $DATA(^OOPS(2260,"D",LOOP))
DO HEAD
if OUT
QUIT
Begin DoDot:1
+2 SET IEN=0
FOR
SET IEN=$ORDER(^OOPS(2260,"D",LOOP,IEN))
if IEN<1!OUT
QUIT
DO DATA
End DoDot:1
+3 QUIT
ONE ; Only 1 Station Selected
+1 IF $DATA(^OOPS(2260,"D",LOOP))
DO HEAD
+2 SET IEN=0
FOR
SET IEN=$ORDER(^OOPS(2260,"D",LOOP,IEN))
if IEN<1!OUT
QUIT
DO DATA
+3 QUIT
DATA ; Loop to get & print data
+1 NEW CASE,NAME,SSN1,DATE,INC,CAT,YR
+2 SET CASE=$$GET1^DIQ(2260,IEN,.01)
+3 SET YR=$EXTRACT(CASE,1,4)
+4 IF YEAR
IF YEAR'=YR
QUIT
+5 ; Only get OPEN cases - field 51 - 0 = OPEN
+6 IF $$GET1^DIQ(2260,IEN,51,"I")
QUIT
+7 SET INC=$$GET1^DIQ(2260,IEN,52,"I")
+8 SET NAME=$EXTRACT($$GET1^DIQ(2260,IEN,1,"E"),1,30)
+9 SET SSN1=$$GET1^DIQ(2260,IEN,5,"E")
+10 SET DATE=$$GET1^DIQ(2260,IEN,4,"E")
+11 SET CAT=$$GET1^DIQ(2260,IEN,2,"I")
+12 SET CNT=CNT+1
+13 IF CALLER="E"
if SSN'=SSN1
QUIT
+14 IF CALLER="S"
IF ($$GET1^DIQ(2260,IEN,53,"I")'=DUZ)
IF ($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ)
QUIT
+15 SET OUTPUT=1
+16 DO HEAD
if OUT
QUIT
+17 WRITE !!,CASE
+18 if CALLER'="U"
WRITE ?12,NAME,?42,SSN1
+19 WRITE ?57,DATE
+20 WRITE !,?35," CA1 ",?50," CA2 ",?65," 2162 "
+21 WRITE !,?35,"---------",?50,"---------",?65,"---------"
+22 ; Employee Data
Begin DoDot:1
+23 NEW SIGN
+24 SET SIGN=$$EDSTA^OOPSUTL1(IEN,"E")
+25 WRITE !,?20,"EMPLOYEE:"
+26 IF INC=1
WRITE ?35
+27 IF INC=2
WRITE ?50
+28 ; Also, not a Non-PAID Employee either
+29 ; Patch 5 - logic changed for new Personnel Categories
+30 IF '$$ISEMP^OOPSUTL4(IEN)
WRITE "N/A(",$EXTRACT($$GET1^DIQ(2260,IEN,2,"E"),1,7),")"
QUIT
+31 WRITE $SELECT($PIECE(SIGN,U,INC):" ",1:"UN-"),"SIGNED"
+32 QUIT
End DoDot:1
+33 if CALLER="E"
QUIT
+34 ; Supervisor Data
Begin DoDot:1
+35 NEW SIGN
+36 SET SIGN=$$EDSTA^OOPSUTL1(IEN,"S")
+37 WRITE !,?20,"SUPERVISOR:"
+38 IF INC=1
WRITE ?35
+39 IF INC=2
WRITE ?50
+40 ;Also not a Non-Paid Employee either
+41 ; Patch 5 - See above
+42 IF '$$ISEMP^OOPSUTL4(IEN)
WRITE "N/A(",$EXTRACT($$GET1^DIQ(2260,IEN,2,"E"),1,7),")"
+43 IF '$TEST
WRITE $SELECT($PIECE(SIGN,U,INC):" ",1:"UN-"),"SIGNED"
+44 WRITE ?65,$SELECT($PIECE(SIGN,U,3):" ",1:"UN-"),"SIGNED"
+45 QUIT
End DoDot:1
+46 if CALLER="S"
QUIT
+47 ; Safety Officer Data
Begin DoDot:1
+48 NEW SIGN
+49 SET SIGN=$$EDSTA^OOPSUTL1(IEN,"O")
+50 WRITE !,?20,"SAFETY OFFICER:"
+51 WRITE ?65,$SELECT($PIECE(SIGN,U):" ",1:"UN-"),"SIGNED"
+52 QUIT
End DoDot:1
+53 QUIT
HEAD ; This is the head portion of the routine
+1 IF PAGE=1
Begin DoDot:1
+2 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 QUIT
End DoDot:1
+4 IF PAGE'=1
if ($Y<(IOSL-6)&('HEAD))
QUIT
+5 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+6 IF PAGE=1
WRITE @IOF
QUIT
+7 IF PAGE'=1
Begin DoDot:2
+8 NEW DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET OUT=1
+9 KILL Y
+10 QUIT
End DoDot:2
if OUT
QUIT
+11 QUIT
End DoDot:1
if OUT
QUIT
+12 if OUT
QUIT
+13 IF PAGE'=1
WRITE @IOF
+14 NEW LINER,TAB,LINE2,TAB2
+15 WRITE !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"PAGE: ",PAGE,!
+16 SET LINER="Accident Report Status"_$SELECT(YEAR="":"",1:" for the fiscal Year "_YEAR)
+17 SET TAB=(40-($LENGTH(LINER)/2))
+18 SET LINE2="Station Number: "_$$GET1^DIQ(4,LOOP,.01,"E")
+19 SET TAB2=(40-($LENGTH(LINE2)/2))
+20 WRITE ?TAB,LINER,!,?TAB2,LINE2
+21 WRITE !,"Case No."
+22 if CALLER'="U"
WRITE ?12,"Name",?46,"SSN"
+23 WRITE ?57,"DATE OF INCIDENT"
+24 WRITE !,"============================================================================="
+25 SET PAGE=PAGE+1
SET HEAD=""
+26 QUIT
