source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSSUP1.m@ 1154

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

initial load of WorldVistAEHR

File size: 5.4 KB
RevLine 
[613]1OOPSSUP1 ;HINES/WAA-S/E Supervisor Edit routine ;04/17/1998
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4EN1(CALLER) ; Main Entry Point
5 S CALLER=$G(CALLER,"S") ; check CALLER
6 N SSN,IEN,EDIT,OUT,FORM,SUP,SER
7 S EDIT=""
8 S (OUT,IEN)=0
9 Q:DUZ<1
10 Q:$G(^VA(200,DUZ,1))=""
11 D INCIDENT(CALLER) Q:IEN<1 ; Select a Employee
12 D ^OOPSDIS ; Display header information
13 D SELECT ; Select the form to be processed.
14 Q:EDIT=""
15 D FORMS ; Process the forms that ther user selected
16 L -^OOPS(2260,IEN)
17 Q
18SELECT ; Select a form
19 ; Injury (2162,CA1)
20 ; Illness (2162,CA2)
21 ; VA form 2162
22 ; Get the type of incident
23 ; If the supporting global doesn't exist force the
24 ; Supervisor to fill both the 2162 and supporting form.
25 N SIGN,INC,SAFE,CAT,INCTYP
26 S EDIT=""
27 S SIGN=$$EDSTA^OOPSUTL1(IEN,"S")
28 S INC=$$GET1^DIQ(2260,IEN,52,"I")
29 S SAFE=+$$EDSTA^OOPSUTL1(IEN,"O")
30 ; Allow Non-PAID employee - CAT=6
31 S CAT=$$GET1^DIQ(2260,IEN,2,"I")
32 ; Patch 5 - change logic for other Personnel Types
33 I '$$ISEMP^OOPSUTL4(IEN),'SAFE S EDIT="2162" Q ;Person not EMP/NONPAID
34 I SAFE S EDIT=$P("CA1^CA2",U,INC) Q
35 ; ^...The safety officer has sign and ca1 or ca2 can be edited
36 S INCTYP=$P("CA1^CA2",U,INC)
37 I $P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC),$P($$EDSTA^OOPSUTL1(IEN,"S"),U,INC) S EDIT="2162" Q
38 I '$$CHECK^OOPSUTL3(IEN,INCTYP) S EDIT="2162^"_INCTYP Q
39 ; No data has been entered for the ca1/2
40 ; ^^^ Force the Super to edit both and once.
41 S EDIT=""
42 I '$P(SIGN,U,3)
43 N DIR,Y
44 N PROMPT1,PROMPT2,SEL1,SEL2
45 S PROMPT1="1) VA FORM 2162 "
46 S PROMPT2=" 2) "_$S(INC=1:"Injury (CA1",INC=2:"Illness (CA2",1:"")_")"
47 W !," Select form: ",PROMPT1
48 W !,PROMPT2
49 S DIR(0)="SAO^1:2162;2:"_$S(INC=1:"CA1",INC=2:"CA2",1:"")
50 S DIR("A")=" Select form: "
51 S DIR("?")=" Select the form to be edited."
52 D ^DIR
53 I '$D(Y(0)) S EDIT="" Q
54 S EDIT=Y(0)
55 K MAX,MAX1
56 Q
57INCIDENT(CALLER) ; Select a case
58 N DIC,X
59 S DIC="^OOPS(2260,"
60 I CALLER="S" S DIC("S")="I $$SUP^OOPSSUP1(Y)"
61 I CALLER="O" S DIC("S")="I $$SAFETY^OOPSSUP1(Y)"
62 S DIC(0)="AEMNZ",DIC("A")=" Select Case: "
63 D ^DIC
64 Q:Y<1
65 Q:$D(DTOUT)!($D(DUOUT))
66 S IEN=$P(Y,U)
67 Q
68SUP(IEN) ; Supervisor Screen
69 N VIEW,ISEMP
70 S VIEW=1
71 I $$GET1^DIQ(2260,IEN,51,"I") S VIEW=0 ; Case is not open
72 I $$GET1^DIQ(2260,IEN,53,"I")'=DUZ,$$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ S VIEW=0 ; Not the Super or Alternate Super
73 ; Patch 5 - new $$ for determining if employee
74 S ISEMP=$$ISEMP^OOPSUTL4(IEN)
75 I 'ISEMP D ; person is not an employee
76 .I +$$EDSTA^OOPSUTL1(IEN,"O") S VIEW=0 Q ; Safety has signed
77 .Q
78 I ISEMP D ; filters emps who have sign, sup who sign & safety who sign
79 .S INC=$$GET1^DIQ(2260,IEN,52,"I")
80 .I $P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC),$P($$EDSTA^OOPSUTL1(IEN,"S"),U,INC),+$$EDSTA^OOPSUTL1(IEN,"O") S VIEW=0
81 .Q
82 Q VIEW
83SAFETY(IEN) ; Safety officer screen
84 N VIEW,INC,ISEMP
85 S VIEW=1
86 S INC=$$GET1^DIQ(2260,IEN,52,"I")
87 I $$GET1^DIQ(2260,IEN,51,"I") S VIEW=0 ; Case is not open
88 S ISEMP=$$ISEMP^OOPSUTL4(IEN)
89 I 'ISEMP D ; person is not an employee
90 .I +$$EDSTA^OOPSUTL1(IEN,"O") S VIEW=0 Q ; Safety has signed
91 .Q
92 I ISEMP D ; This will filter emps who have sign, sup who sign and safety who sign
93 .I $P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC),$P($$EDSTA^OOPSUTL1(IEN,"S"),U,INC),+$$EDSTA^OOPSUTL1(IEN,"O") S VIEW=0
94 .Q
95 I $$GET1^DIQ(2260,IEN,53,"I")'=DUZ,$$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ D
96 .I $P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC),$P($$EDSTA^OOPSUTL1(IEN,"S"),U,INC),$P($$EDSTA^OOPSUTL1(IEN,"S"),U,3) S VIEW=0
97 .Q
98 Q VIEW
99FORMS ; Process Form
100 N I
101 ;Patch 7 - new variables used
102 N AIEN,AGN,ADD,CITY,STATE,ZIP,PNAME,PADD,PCITY,PSTATE,PZIP,STAT,SIEN
103 N FLD,PAY,RET,SAL
104 ; Get default fields from PAID
105 S FLD=28,SAL=""
106 S SAL=$$PAID^OOPSUTL1(IEN,FLD)
107 S FLD=26,RET=""
108 S RET=$$PAID^OOPSUTL1(IEN,FLD)
109 S RET=$S(RET="FULL CSRS":"CSRS",RET="FERS":"FERS",1:"OTHER")
110 S FLD=19,PAY=""
111 S PAY=$$PAID^OOPSUTL1(IEN,FLD)
112 S PAY=$S(PAY="PER ANNUM":"ANNUAL",PAY="PER HOUR":"HOURLY","PER DIEM":"DAILY","BIWEEKLY":"BI-WEEKLY",1:"")
113 F I=1:1 S FORM=$P(EDIT,U,I) Q:FORM="" D Q:OUT
114 .N DR,DIE,SIGN,EDIT,I
115 .I (CALLER="S"),($$GET1^DIQ(2260,IEN,53,"I")=DUZ!($$GET1^DIQ(2260,IEN,53.1,"I")=DUZ)) D CLRES^OOPSUTL1(IEN,"S",FORM)
116 .I FORM="2162" D ASIST^OOPSSUP3 Q:OUT
117 .I FORM="CA1" D CA1^OOPSSUPB Q:OUT
118 .I FORM="CA2" D CA2^OOPSSUP2 Q:OUT
119 .S DIE="^OOPS(2260,",DA=IEN
120 .L +^OOPS(2260,IEN):2
121 .E W !!?5,"Another user is editing this entry. Try later." S OUT=1 Q
122 .D ^DIE
123 .I ($D(Y)'=0)!($G(DIRUT)=1) S OUT=1 Q ; Quit if user exits
124 .I $$GET1^DIQ(2260,IEN,53,"I")'=DUZ,$$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ Q
125 .D SIGNS(FORM) ; Sign/validate Document
126 .Q:'$P(SIGN,U) ; Quit if user doesn't sign
127 .D FILE ; User Signs and files
128 .Q
129 Q
130SIGNS(FORM) ; Sign/validate Document
131 N EMP,INC,VALID
132 S VALID=0,SIGN=""
133 S EMP=$$EDSTA^OOPSUTL1(IEN,"E")
134 S INC=$$GET1^DIQ(2260,IEN,52,"I")
135 D VALIDATE^OOPSUTL4(IEN,FORM,"S",.VALID)
136 I FORM'="2162",'$P(EMP,U,INC) D Q ;Employee has not signed yet
137 .W !,?10,"The employee has not signed the ",FORM,"." Q
138 .Q
139 I FORM=2162,CALLER="O",('$P($$EDSTA^OOPSUTL1(IEN,"S"),U,3)) D Q
140 .W !?10,"Supervisor must sign before Safety Officer"
141 I 'VALID Q
142 S SIGN=$$SIG^OOPSESIG(DUZ,IEN)
143 Q
144FILE ;File the ES and send a bull
145 I FORM="2162" D
146 . I CALLER="S" S $P(^OOPS(2260,IEN,"2162ES"),U,1,3)=SIGN D SAFETY^OOPSMBUL(IEN)
147 . I CALLER="O" S $P(^OOPS(2260,IEN,"2162ES"),U,4,6)=SIGN
148 I FORM="CA1" S $P(^OOPS(2260,IEN,"CA1ES"),U,4,6)=SIGN D SUPS^OOPSMBUL(IEN),UNION^OOPSMBUL(IEN)
149 I FORM="CA2" S $P(^OOPS(2260,IEN,"CA2ES"),U,4,6)=SIGN D SUPS^OOPSMBUL(IEN),UNION^OOPSMBUL(IEN)
150 Q
Note: See TracBrowser for help on using the repository browser.