source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSPCA.m@ 1195

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1OOPSPCA ;HIRMFO/YH-CA1/CA2 FORM PRINT ;2/19/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3EN1(CASE,FORM) ; ENTRY POINT TO PRINT THE REPORT OF ACCIDENT FORMS CA1 AND CA2
4 ;CASE - CASE NUMBER (TEXT)
5 ;FORM - CA-1 OR CA-2
6 Q:FORM=""
7 N IEN S IEN=0
8 I CASE'="",$D(^OOPS(2260,"B",CASE)) S IEN=$O(^OOPS(2260,"B",CASE,0))
9DEV W !!?5,"The CA-1 and CA-2 forms require a Hewlett Packard laser jet"
10 W !?5,"(or compatible) printer with PCL (Printer Control Language)"
11 W !?5,"Level 5. Do NOT select the home device."
12 S %ZIS="Q",%ZIS("B")="" W ! D ^%ZIS G:POP Q1
13 I $D(IO("Q")) S ZTDESC=$S(FORM=1:"NOTICE OF TRAUMATIC INJURY",1:""),ZTIO=ION,ZTRTN="START^OOPSPCA",ZTSAVE("IEN")="",ZTSAVE("FORM")=""
14 I $D(IO("Q")) D ^%ZTLOAD,HOME^%ZIS D Q1 Q
15START ; START TO PRINT REPORT OF ACCIDENT FORM CA1 AND CA2
16 U IO
17 I FORM="CA-1" D G Q1
18 . K ^TMP($J) S NN=1,^TMP($J,NN)="Federal Employee's Notice of Traumatic Injury and Claim for Continuation of"
19 . S NN=NN+1,^TMP($J,NN)="Pay/Compensation (Continued)"
20 . D ^OOPSPC10,^OOPSPC20,^OOPSPC30
21 . I IEN=0 D ^OOPSPC70
22 . I NN>2 D
23 . . S PAGE=1,LINE=0 D PRINTXT
24 I FORM="CA-2" D G Q1
25 . K ^TMP($J) S NN=1,^TMP($J,NN)="Notice of Occupational Disease and Claim for Compensation (Continued)"
26 . D ^OOPSPC40,^OOPSPC50,^OOPSPC60
27 . I IEN=0 D ^OOPSPC80
28 . I NN>1 D
29 . . S PAGE=1,LINE=0 D PRINTXT
30Q1 K ^TMP($J),PAGE,LINE,NN,OOPSDATA,OOPSP,ZTSK,ZTIO S:$D(ZTQUEUED) ZTREQ="@" W @IOF D ^%ZISC Q
31PRINTXT ;PRINT
32 N DIWL,DIWR,DIWF,X,II,OOPSWP
33 K ^UTILITY($J,"W")
34 S DIWL=1,DIWR="",DIWF="C76"
35 W @IOF,?70,"Page "_PAGE,!
36 F II=1:1:NN D
37 .S X=^TMP($J,II)
38 .D ^DIWP
39 S OOPSWP=^UTILITY($J,"W",1)
40 F I=1:1:OOPSWP D
41 .W !,^UTILITY($J,"W",1,I,0)
42 .S LINE=LINE+1
43 .I LINE=65 S PAGE=PAGE+1,LINE=0 W @IOF,?70,"Page"_PAGE,!,^TMP($J,1),!,^TMP($J,2),!
44 K ^UTILITY($J,"W")
45 Q
46WP(OOPSDIWL,OOPSDIWR,OOPSDIWF,OOPSBS,OOPSNODE,OOPSSEL,OOPSAT,OOPSLBL) ;
47 N DIWL,DIWR,DIWF,X,II,III,OOPSWP,OOPSNUM,OOPSFLAG
48 S OOPSFLAG=0
49 K ^UTILITY($J,"W")
50 S DIWL=OOPSDIWL,DIWR=OOPSDIWR,DIWF=OOPSDIWF
51 S OOPSNUM=+$P($G(^OOPS(2260,IEN,OOPSNODE,0)),"^",4)
52 I OOPSNUM>0,(OOPSNUM<(OOPSBS+1)) D
53 .F II=1:1:OOPSNUM D
54 ..S X=$G(^OOPS(2260,IEN,OOPSNODE,II,0))
55 ..D ^DIWP
56 .S OOPSWP=^UTILITY($J,"W",1)
57 .S:OOPSWP>OOPSBS OOPSFLAG=1
58 .I OOPSWP<(OOPSBS+1) D
59 ..F II=1:1:OOPSWP D
60 ...X OOPSSEL
61 I OOPSNUM>OOPSBS!(OOPSFLAG) D
62 .X OOPSAT
63 .S NN=NN+1,^TMP($J,NN)=" ",NN=NN+1
64 .S ^TMP($J,NN)=OOPSLBL
65 .S NN=NN+1,^TMP($J,NN)=" "
66 .S I=0 F S I=$O(^OOPS(2260,IEN,OOPSNODE,I)) Q:I'>0 D
67 ..S NN=NN+1,^TMP($J,NN)=^OOPS(2260,IEN,OOPSNODE,I,0)
68 K ^UTILITY($J,"W")
69 Q
Note: See TracBrowser for help on using the repository browser.