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 ---[H[J[2J[HOOPSPCA 2579 printed Nov 22, 2024@16:49:46 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
