OOPSPRT1.m

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 ---OOPSPRT1   5215     printed  Mar 13, 2025@20:44:15                                                                                                                                                                                                    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