OOPSPCA.m

OOPSPCA ;HIRMFO/YH-CA1/CA2 FORM PRINT ;2/19/98

 ;;2.0;ASISTS;;Jun 03, 2002

EN1(CASE,FORM) ; ENTRY POINT TO PRINT THE REPORT OF ACCIDENT FORMS CA1 AND CA2

 ;CASE - CASE NUMBER (TEXT)

 ;FORM - CA-1 OR CA-2

 Q:FORM=""

 N IEN S IEN=0

 I CASE'="",$D(^OOPS(2260,"B",CASE)) S IEN=$O(^OOPS(2260,"B",CASE,0))

DEV W !!?5,"The CA-1 and CA-2 forms require a Hewlett Packard laser jet"

 W !?5,"(or compatible) printer with PCL (Printer Control Language)"

 W !?5,"Level 5.  Do NOT select the home device."

 S %ZIS="Q",%ZIS("B")="" W ! D ^%ZIS G:POP Q1

 I $D(IO("Q")) S ZTDESC=$S(FORM=1:"NOTICE OF TRAUMATIC INJURY",1:""),ZTIO=ION,ZTRTN="START^OOPSPCA",ZTSAVE("IEN")="",ZTSAVE("FORM")=""

 I $D(IO("Q")) D ^%ZTLOAD,HOME^%ZIS D Q1 Q

START ; START TO PRINT REPORT OF ACCIDENT FORM CA1 AND CA2

 U IO

 I FORM="CA-1" D  G Q1

 . K ^TMP($J) S NN=1,^TMP($J,NN)="Federal Employee's Notice of Traumatic Injury and Claim for Continuation of"

 . S NN=NN+1,^TMP($J,NN)="Pay/Compensation (Continued)"

 . D ^OOPSPC10,^OOPSPC20,^OOPSPC30

 . I IEN=0 D ^OOPSPC70

 . I NN>2 D

 . . S PAGE=1,LINE=0 D PRINTXT

 I FORM="CA-2" D  G Q1

 . K ^TMP($J) S NN=1,^TMP($J,NN)="Notice of Occupational Disease and Claim for Compensation (Continued)"

 . D ^OOPSPC40,^OOPSPC50,^OOPSPC60

 . I IEN=0 D ^OOPSPC80

 . I NN>1 D

 . . S PAGE=1,LINE=0 D PRINTXT

Q1 K ^TMP($J),PAGE,LINE,NN,OOPSDATA,OOPSP,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@" W @IOF D ^%ZISC Q

PRINTXT ;PRINT

 N DIWL,DIWR,DIWF,X,II,OOPSWP

 K ^UTILITY($J,"W")

 S DIWL=1,DIWR="",DIWF="C76"

 W @IOF,?70,"Page "_PAGE,!

 F II=1:1:NN D

 .S X=^TMP($J,II)

 .D ^DIWP

 S OOPSWP=^UTILITY($J,"W",1)

 F I=1:1:OOPSWP D

 .W !,^UTILITY($J,"W",1,I,0)

 .S LINE=LINE+1

 .I LINE=65 S PAGE=PAGE+1,LINE=0 W @IOF,?70,"Page"_PAGE,!,^TMP($J,1),!,^TMP($J,2),!

 K ^UTILITY($J,"W")

 Q

WP(OOPSDIWL,OOPSDIWR,OOPSDIWF,OOPSBS,OOPSNODE,OOPSSEL,OOPSAT,OOPSLBL) ;

 N DIWL,DIWR,DIWF,X,II,III,OOPSWP,OOPSNUM,OOPSFLAG

 S OOPSFLAG=0

 K ^UTILITY($J,"W")

 S DIWL=OOPSDIWL,DIWR=OOPSDIWR,DIWF=OOPSDIWF

 S OOPSNUM=+$P($G(^OOPS(2260,IEN,OOPSNODE,0)),"^",4)

 I OOPSNUM>0,(OOPSNUM<(OOPSBS+1)) D

 .F II=1:1:OOPSNUM  D

 ..S X=$G(^OOPS(2260,IEN,OOPSNODE,II,0))

 ..D ^DIWP

 .S OOPSWP=^UTILITY($J,"W",1)

 .S:OOPSWP>OOPSBS OOPSFLAG=1

 .I OOPSWP<(OOPSBS+1) D

 ..F II=1:1:OOPSWP  D

 ...X OOPSSEL

 I OOPSNUM>OOPSBS!(OOPSFLAG) D

 .X OOPSAT

 .S NN=NN+1,^TMP($J,NN)="   ",NN=NN+1

 .S ^TMP($J,NN)=OOPSLBL

 .S NN=NN+1,^TMP($J,NN)="   "

 .S I=0 F  S I=$O(^OOPS(2260,IEN,OOPSNODE,I)) Q:I'>0  D

 ..S NN=NN+1,^TMP($J,NN)=^OOPS(2260,IEN,OOPSNODE,I,0)

 K ^UTILITY($J,"W")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OOPSPCA   2579     printed  Apr 23, 2025@17:53:59                                                                                                                                                                                                     Page 2

OOPSPCA   ;HIRMFO/YH-CA1/CA2 FORM PRINT ;2/19/98

 +1       ;;2.0;ASISTS;;Jun 03, 2002

EN1(CASE,FORM) ; ENTRY POINT TO PRINT THE REPORT OF ACCIDENT FORMS CA1 AND CA2

 +1       ;CASE - CASE NUMBER (TEXT)

 +2       ;FORM - CA-1 OR CA-2

 +3        if FORM=""

               QUIT 

 +4        NEW IEN

           SET IEN=0

 +5        IF CASE'=""

               IF $DATA(^OOPS(2260,"B",CASE))

                   SET IEN=$ORDER(^OOPS(2260,"B",CASE,0))

DEV        WRITE !!?5,"The CA-1 and CA-2 forms require a Hewlett Packard laser jet"

 +1        WRITE !?5,"(or compatible) printer with PCL (Printer Control Language)"

 +2        WRITE !?5,"Level 5.  Do NOT select the home device."

 +3        SET %ZIS="Q"

           SET %ZIS("B")=""

           WRITE !

           DO ^%ZIS

           if POP

               GOTO Q1

 +4        IF $DATA(IO("Q"))

               SET ZTDESC=$SELECT(FORM=1:"NOTICE OF TRAUMATIC INJURY",1:"")

               SET ZTIO=ION

               SET ZTRTN="START^OOPSPCA"

               SET ZTSAVE("IEN")=""

               SET ZTSAVE("FORM")=""

 +5        IF $DATA(IO("Q"))

               DO ^%ZTLOAD

               DO HOME^%ZIS

               DO Q1

               QUIT 

START     ; START TO PRINT REPORT OF ACCIDENT FORM CA1 AND CA2

 +1        USE IO

 +2        IF FORM="CA-1"

               Begin DoDot:1

 +3                KILL ^TMP($JOB)

                   SET NN=1

                   SET ^TMP($JOB,NN)="Federal Employee's Notice of Traumatic Injury and Claim for Continuation of"

 +4                SET NN=NN+1

                   SET ^TMP($JOB,NN)="Pay/Compensation (Continued)"

 +5                DO ^OOPSPC10

                   DO ^OOPSPC20

                   DO ^OOPSPC30

 +6                IF IEN=0

                       DO ^OOPSPC70

 +7                IF NN>2

                       Begin DoDot:2

 +8                        SET PAGE=1

                           SET LINE=0

                           DO PRINTXT

                       End DoDot:2

               End DoDot:1

               GOTO Q1

 +9        IF FORM="CA-2"

               Begin DoDot:1

 +10               KILL ^TMP($JOB)

                   SET NN=1

                   SET ^TMP($JOB,NN)="Notice of Occupational Disease and Claim for Compensation (Continued)"

 +11               DO ^OOPSPC40

                   DO ^OOPSPC50

                   DO ^OOPSPC60

 +12               IF IEN=0

                       DO ^OOPSPC80

 +13               IF NN>1

                       Begin DoDot:2

 +14                       SET PAGE=1

                           SET LINE=0

                           DO PRINTXT

                       End DoDot:2

               End DoDot:1

               GOTO Q1

Q1         KILL ^TMP($JOB),PAGE,LINE,NN,OOPSDATA,OOPSP,ZTSK,ZTIO

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           WRITE @IOF

           DO ^%ZISC

           QUIT 

PRINTXT   ;PRINT

 +1        NEW DIWL,DIWR,DIWF,X,II,OOPSWP

 +2        KILL ^UTILITY($JOB,"W")

 +3        SET DIWL=1

           SET DIWR=""

           SET DIWF="C76"

 +4        WRITE @IOF,?70,"Page "_PAGE,!

 +5        FOR II=1:1:NN

               Begin DoDot:1

 +6                SET X=^TMP($JOB,II)

 +7                DO ^DIWP

               End DoDot:1

 +8        SET OOPSWP=^UTILITY($JOB,"W",1)

 +9        FOR I=1:1:OOPSWP

               Begin DoDot:1

 +10               WRITE !,^UTILITY($JOB,"W",1,I,0)

 +11               SET LINE=LINE+1

 +12               IF LINE=65

                       SET PAGE=PAGE+1

                       SET LINE=0

                       WRITE @IOF,?70,"Page"_PAGE,!,^TMP($JOB,1),!,^TMP($JOB,2),!

               End DoDot:1

 +13       KILL ^UTILITY($JOB,"W")

 +14       QUIT 

WP(OOPSDIWL,OOPSDIWR,OOPSDIWF,OOPSBS,OOPSNODE,OOPSSEL,OOPSAT,OOPSLBL) ;

 +1        NEW DIWL,DIWR,DIWF,X,II,III,OOPSWP,OOPSNUM,OOPSFLAG

 +2        SET OOPSFLAG=0

 +3        KILL ^UTILITY($JOB,"W")

 +4        SET DIWL=OOPSDIWL

           SET DIWR=OOPSDIWR

           SET DIWF=OOPSDIWF

 +5        SET OOPSNUM=+$PIECE($GET(^OOPS(2260,IEN,OOPSNODE,0)),"^",4)

 +6        IF OOPSNUM>0

               IF (OOPSNUM<(OOPSBS+1))

                   Begin DoDot:1

 +7                    FOR II=1:1:OOPSNUM

                           Begin DoDot:2

 +8                            SET X=$GET(^OOPS(2260,IEN,OOPSNODE,II,0))

 +9                            DO ^DIWP

                           End DoDot:2

 +10                   SET OOPSWP=^UTILITY($JOB,"W",1)

 +11                   if OOPSWP>OOPSBS

                           SET OOPSFLAG=1

 +12                   IF OOPSWP<(OOPSBS+1)

                           Begin DoDot:2

 +13                           FOR II=1:1:OOPSWP

                                   Begin DoDot:3

 +14                                   XECUTE OOPSSEL

                                   End DoDot:3

                           End DoDot:2

                   End DoDot:1

 +15       IF OOPSNUM>OOPSBS!(OOPSFLAG)

               Begin DoDot:1

 +16               XECUTE OOPSAT

 +17               SET NN=NN+1

                   SET ^TMP($JOB,NN)="   "

                   SET NN=NN+1

 +18               SET ^TMP($JOB,NN)=OOPSLBL

 +19               SET NN=NN+1

                   SET ^TMP($JOB,NN)="   "

 +20               SET I=0

                   FOR 

                       SET I=$ORDER(^OOPS(2260,IEN,OOPSNODE,I))

                       if I'>0

                           QUIT 

                       Begin DoDot:2

 +21                       SET NN=NN+1

                           SET ^TMP($JOB,NN)=^OOPS(2260,IEN,OOPSNODE,I,0)

                       End DoDot:2

               End DoDot:1

 +22       KILL ^UTILITY($JOB,"W")

 +23       QUIT