source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSCA1.m@ 691

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

initial load of WorldVistAEHR
File size: 8.0 KB
Line 
1OOPSCA1 ;WIOFO/CAH-CA1 DISPLAY ;12/02/99
2 ;;2.0;ASISTS;;Jun 03, 2002
3CA1(IEN,CALL) ;
4CA1PG1 N LIN S PG=0,EX="",LIN=$S(($E(IOST,1,2)="C-"):IOSL-2,1:IOSL-6)
5 K DIQ,DA,DR
6 S DIC="^OOPS(2260,"
7 S DR=".01;1;4:12;15:17;60:63;70;107;108;110:118;121:124;126:136;138:149;150:169;171:174;175:185",DA=IEN,DIQ="OOPS"
8 D EN^DIQ1
9 ; Get witness data
10 K DR
11 N WIT,LSR
12 S LSR=$P($G(^OOPS(2260,IEN,"CA1W",0)),U,3)
13 S WIT=$O(^OOPS(2260,IEN,"CA1W",0))
14 I $G(WIT) D
15 . S DR="125",DR(2260.0125)=".01:7",DA=IEN
16 . F II=WIT:1:LSR I $D(^OOPS(2260,IEN,"CA1W",II)) S DA(2260.0125)=II D EN^DIQ1
17 D HDR
18 W !,"NAME OF EMPLOYEE...............: ",OOPS(2260,IEN,1) D P Q:EX=U
19 W !,"SSN............................: ",OOPS(2260,IEN,5) D P Q:EX=U
20 W !,"DOB............................: ",OOPS(2260,IEN,6) D P Q:EX=U
21 W !,"SEX............................: ",OOPS(2260,IEN,7) D P Q:EX=U
22 W !,"HOME TELEPHONE.................: ",OOPS(2260,IEN,12) D P Q:EX=U
23 W !,"GRADE/STEP.....................: ",OOPS(2260,IEN,16) W:OOPS(2260,IEN,16)'="" "/" W OOPS(2260,IEN,17) D P Q:EX=U
24 W !,"PAY PLAN.......................: ",OOPS(2260,IEN,63) D P Q:EX=U
25 W !,"EMPLOYEE'S ADDRESS.............: ",OOPS(2260,IEN,8) D P Q:EX=U
26 W !,"CITY...........................: ",OOPS(2260,IEN,9) D P Q:EX=U
27 W !,"STATE..........................: ",OOPS(2260,IEN,10) D P Q:EX=U
28 W !,"ZIP............................: ",OOPS(2260,IEN,11) D P Q:EX=U
29 W !,"DEPENDENTS.....................: ",OOPS(2260,IEN,107) D P Q:EX=U
30 W !,"PLACE WHERE INJURY OCCURRED....: ",OOPS(2260,IEN,108) D P Q:EX=U
31 W !,"STREET WHERE INJURY OCCURRED...: ",OOPS(2260,IEN,183) D P Q:EX=U
32 W !,"CITY WHERE INJURY OCCURRED.....: ",OOPS(2260,IEN,184) D P Q:EX=U
33 W !,"STATE WHERE INJURY OCCURRED....: ",OOPS(2260,IEN,185) D P Q:EX=U
34 W !,"ZIP CODE WHERE INJURY OCCURRED.: ",OOPS(2260,IEN,181) D P Q:EX=U
35 W !,"DATE/TIME OF OCCURRENCE........: ",OOPS(2260,IEN,4) D P Q:EX=U
36 W !,"DATE OF THIS NOTICE............: ",OOPS(2260,IEN,110) D P Q:EX=U
37 W !,"EMPLOYEE'S OCCUPATION..........: ",OOPS(2260,IEN,111) D P Q:EX=U
38 W !,"CAUSE OF INJURY CODE...........: ",OOPS(2260,IEN,126) D P Q:EX=U
39 W !,"CAUSE OF INJURY................: ",OOPS(2260,IEN,112) D P Q:EX=U
40 W !,"NATURE OF INJURY...............: ",OOPS(2260,IEN,113) D P Q:EX=U
41 W !,"REQUEST PAY OR LEAVE...........: ",OOPS(2260,IEN,114) D P Q:EX=U
42 W !,"EMPLOYEE DATE OF SIGNATURE.....: ",OOPS(2260,IEN,121) D P Q:EX=U
43 I $D(OOPS(2260.0125)) F II=WIT:1:LSR I $D(OOPS(2260.0125,II)) D Q:EX=U
44 .W !,"WITNESS INFORMATION:"
45 .W !,"NAME OF WITNESS................: ",OOPS(2260.0125,II,.01) D P Q:EX=U
46 .W !,"WITNESS ADDRESS................: ",OOPS(2260.0125,II,1) D P Q:EX=U
47 .W !,"WITNESS CITY...................: ",OOPS(2260.0125,II,2) D P Q:EX=U
48 .W !,"WITNESS STATE..................: ",OOPS(2260.0125,II,3) D P Q:EX=U
49 .W !,"WITNESS ZIP CODE...............: ",OOPS(2260.0125,II,4) D P Q:EX=U
50 .W !,"DATE OF WITNESS SIGNATURE......: ",OOPS(2260.0125,II,5) D P Q:EX=U
51 .W !,"STATEMENT OF WITNESS...........: ",OOPS(2260.0125,II,6) D P Q:EX=U
52 I CALL="E" D G KILL
53 .I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E" D ^DIR W @IOF
54CA1PG2 ;
55 ; Changed from field 122 to 15
56 W !,"OCCUPATION CODE................: ",OOPS(2260,IEN,15) D P Q:EX=U
57 W !,"NOI CODE.......................: ",OOPS(2260,IEN,62) D P Q:EX=U
58 W !,"TYPE CODE......................: ",OOPS(2260,IEN,123) D P Q:EX=U
59 W !,"SOURCE CODE....................: ",OOPS(2260,IEN,124) D P Q:EX=U
60 W !,"OWCP CHARGEBACK CODE...........: ",OOPS(2260,IEN,70) D P Q:EX=U
61 D:$D(OOPS(2260,IEN,130)) Q:EX=U
62 .W !,"AGENCY NAME....................: ",OOPS(2260,IEN,130) D P Q:EX=U
63 .W !,"AGENCY ADDRESS.................: ",OOPS(2260,IEN,131) D P Q:EX=U
64 .W !,"AGENCY CITY....................: ",OOPS(2260,IEN,132) D P Q:EX=U
65 .W !,"AGENCY STATE...................: ",OOPS(2260,IEN,133) D P Q:EX=U
66 .W !,"AGENCY ZIP CODE................: ",OOPS(2260,IEN,134) D P Q:EX=U
67 D:$D(OOPS(2260,IEN,176)) Q:EX=U
68 .W !,"EMPLOYEE'S DUTY STATION........: ",OOPS(2260,IEN,176) D P Q:EX=U
69 .W !,"DUTY STATION ADDRESS...........: ",OOPS(2260,IEN,177) D P Q:EX=U
70 .W !,"DUTY STATION CITY..............: ",OOPS(2260,IEN,178) D P Q:EX=U
71 .W !,"DUTY STATION STATE.............: ",OOPS(2260,IEN,179) D P Q:EX=U
72 .W !,"DUTY STATION ZIP CODE..........: ",OOPS(2260,IEN,180) D P Q:EX=U
73 W !,"EMPLOYEE RETIREMENT COVERAGE...: ",OOPS(2260,IEN,60) D P Q:EX=U
74 I $D(OOPS(2260,IEN,61)) D Q:EX=U
75 . W !,"EMP RETIREMENT COVERAGE DESC...: ",OOPS(2260,IEN,61) D P Q:EX=U
76 W !,"REGULAR HRS FROM TIME..........: ",OOPS(2260,IEN,138) D P Q:EX=U
77 W !,"REGULAR HRS TO TIME............: ",OOPS(2260,IEN,139) D P Q:EX=U
78 W !,"REGULAR WORK SCHEDULE..........: ",OOPS(2260,IEN,140) D P Q:EX=U
79 W !,"DATE OF INJURY.................: ",OOPS(2260,IEN,4) D P Q:EX=U
80 W !,"DATE NOTICE RECEIVED...........: ",OOPS(2260,IEN,175) D P Q:EX=U
81 W !,"DATE/TIME STOPPED WORK.........: ",OOPS(2260,IEN,142) D P Q:EX=U
82 W !,"DATE PAY STOPPED...............: ",OOPS(2260,IEN,143) D P Q:EX=U
83 W !,"DATE 45 DAY PERIOD BEGAN.......: ",OOPS(2260,IEN,144) D P Q:EX=U
84 W !,"DATE/TIME RETURNED TO WORK.....: ",OOPS(2260,IEN,145) D P Q:EX=U
85 W !,"INJURED PERFORMING DUTY........: ",OOPS(2260,IEN,146) D P Q:EX=U
86 W !,"NOT INJURED PERFORMING JOB.....: ",OOPS(2260,IEN,147) D P Q:EX=U
87 W !,"INJURY CAUSED BY EMPLOYEE......: ",OOPS(2260,IEN,148) D P Q:EX=U
88 W !,"CAUSED BY EMPLOYEE EXPLAIN.....: ",OOPS(2260,IEN,149) D P Q:EX=U
89 W !,"INJURY CAUSED BY 3RD PARTY.....: ",OOPS(2260,IEN,150) D P Q:EX=U
90 D:$D(OOPS(2260,IEN,151)) Q:EX=U
91 .W !,"3RD PARTY NAME.................: ",OOPS(2260,IEN,151) D P Q:EX=U
92 .W !,"3RD PARTY ADDRESS..............: ",OOPS(2260,IEN,152) D P Q:EX=U
93 .W !,"3RD PARTY CITY.................: ",OOPS(2260,IEN,153) D P Q:EX=U
94 .W !,"3RD PARTY STATE................: ",OOPS(2260,IEN,154) D P Q:EX=U
95 .W !,"3RD PARTY ZIP CODE.............: ",OOPS(2260,IEN,155) D P Q:EX=U
96 D:$D(OOPS(2260,IEN,156)) Q:EX=U
97 .W !,"PROVIDING PHYSICAN NAME........: ",OOPS(2260,IEN,156) D P Q:EX=U
98 .W !,"PROVIDING PHYSICIAN ADDRESS....: ",OOPS(2260,IEN,157) D P Q:EX=U
99 .W !,"PROVIDING PHYSICIAN CITY.......: ",OOPS(2260,IEN,158) D P Q:EX=U
100 .W !,"PROVIDING PHYSICIAN STATE......: ",OOPS(2260,IEN,159) D P Q:EX=U
101 .W !,"PROVIDING PHYSICIAN ZIP CODE...: ",OOPS(2260,IEN,160) D P Q:EX=U
102 .W !,"PROVIDING PHYSICIAN TITLE......: ",OOPS(2260,IEN,182) D P Q:EX=U
103 W !,"FIRST DATE OF MEDICAL CARE.....: ",OOPS(2260,IEN,161) D P Q:EX=U
104 W !,"DISABLED FOR WORK..............: ",OOPS(2260,IEN,162) D P Q:EX=U
105 W !,"SUPERVISOR AGREE/DISAGREE......: ",OOPS(2260,IEN,163) D P Q:EX=U
106 W !,"SUPERVISOR NOT AGREE EXPLAIN...: "
107 S OPFLD=164 D WP K OPFLD Q:EX=U
108 W !,"REASON FOR CONTROVERTS COP.....: "
109 S OPFLD=165 D WP K OPFLD Q:EX=U
110 W !,"PAY RATE WHEN WORK STOPPED.....: ",OOPS(2260,IEN,166),"/",OOPS(2260,IEN,167) D P Q:EX=U
111 W !,"SUPERVISOR EXCEPTION...........: ",OOPS(2260,IEN,168) D P Q:EX=U
112 D:$D(OOPS(2260,IEN,169)) Q:EX=U
113 .W !,"NAME OF SUPERVISOR.............: ",OOPS(2260,IEN,169) D P Q:EX=U
114 .W !,"SUPERVISOR'S DATE OF SIGNATURE.: ",OOPS(2260,IEN,171) D P Q:EX=U
115 .W !,"SUPERVISOR'S TITLE.............: ",OOPS(2260,IEN,172) D P Q:EX=U
116 .W !,"SUPERVISOR'S OFFICE PHONE......: ",OOPS(2260,IEN,173) D P Q:EX=U
117 W !,"FILING INSTRUCTIONS............: ",OOPS(2260,IEN,174) D P Q:EX=U
118 I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E" D ^DIR W @IOF
119KILL ;Kill Variables and Exit
120 S:$D(ZTQUEUED) ZTREQ="@"
121 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,IEN,DASHES,OOPS,DA,DO,EX
122 K DO,DIQ,DISYS,DIW,DIWI,DIWT,DIWTC,DIWX,DN,DR,I,Z,POP
123 Q
124P ;PRINT
125 I ($Y'<(LIN-3)) D Q:EX=U
126 .I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
127 .D HDR Q
128 Q
129WP ;Process Word Processing Fields
130 N DIWL,DIWR,DIWF,OPGLB,OPI,OPNODE,OPT,OPC
131 K ^UTILITY($J,"W")
132 S DIWL=1,DIWR="",DIWF="|C76"
133 S OPNODE=$P($$GET1^DID(2260,OPFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
134 S OPGLB="^OOPS(2260,IEN,OPNODE,OPI)"
135 S OPI=0 F S OPI=$O(@OPGLB) Q:'OPI S X=$G(^(OPI,0)) D:X]"" ^DIWP
136 S OPT=$G(^UTILITY($J,"W",1))+0
137 I OPT S OPI=0 F OPC=1:1 S OPI=$O(^UTILITY($J,"W",1,OPI)) Q:'OPI!(EX=U) D
138 .W !?1,^UTILITY($J,"W",1,OPI,0) D P Q:EX=U
139 K ^UTILITY($J,"W"),X
140 Q
141HDR ;HEADER
142 W @IOF S PG=PG+1 K DASHES S $P(DASHES,"-",80)="-"
143 W !,"Case # ",OOPS(2260,IEN,.01),?73,"Page ",PG
144 W !,DASHES
145 Q
Note: See TracBrowser for help on using the repository browser.