source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSGUI4.m@ 1671

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1OOPSGUI4 ;WIOFO/LLH-RPC BROKER CALLS ;10/02/01
2 ;;2.0;ASISTS;**4,8,7,11**;Jun 03, 2002
3 ;
4PAID(RESULTS,NAME) ; retrieves PAID employee and data from file 450
5 ; Input: NAME - the Employee Name or partial name Passed in
6 ; Output: RESULTS - array containing PAID fields in the order returned
7 ; from FIND^DIC
8 ;
9 N IEN200,LP,PAY,PAYP,PHONE,OCCDESC,RET,SAL,SSN,X,STATE,SERV,SAMEFLG
10 N IEN450
11 I NAME="" S RESULTS(1)="^NO SSN OR NAME PROVIDED" Q
12 S X=NAME,SAMEFLG=0
13 D FIND^DIC(450,,"@;.01;6;8;10;13;16EI;31;32;38;186.1;186.2;186;186.4;458I;30","MPS",X,500)
14 I $G(DIERR) D CLEAN^DILF Q
15 I $P(^TMP("DILIST",$J,0),U)=0 S RESULTS(0)="^NO PAID EMPLOYEE FOUND" Q
16 F LP=0:0 S LP=$O(^TMP("DILIST",$J,LP)) Q:LP="" D
17 .; cannot pick yourself if selecting case,use SSN to see if DUZ matches
18 .S SSN=$TR($P($G(^TMP("DILIST",$J,LP,0)),U,4),"-","")
19 .I $G(SSN) S IEN200=$O(^VA(200,"SSN",SSN,""))
20 .; 12/29/03 llh - also cannot pick a person from the PAID file with
21 .; a pseudo SSN (one that begins with 000)
22 .I $E(SSN,1,3)="000" Q
23 .I DUZ=IEN200 S SAMEFLG=1 Q
24 .S RESULTS(LP)=^TMP("DILIST",$J,LP,0)
25 .S $P(RESULTS(LP),U,5)=$E($P(RESULTS(LP),U,5),1,45)
26 .S $P(RESULTS(LP),U,8)=$E($P($G(RESULTS(LP)),U,8),1,4)
27 .S PHONE="" ; ,SSN=$TR($P($G(RESULTS(LP)),U,4),"-","")
28 .I $G(IEN200) S PHONE=$P($G(^VA(200,IEN200,.13)),U)
29 .I $TR(PHONE,"(,)-^*/# &%@!","")'?10N S PHONE="" ;Must be 10 char
30 .S RESULTS(LP)=RESULTS(LP)_U_PHONE
31 .S IEN450=$P(RESULTS(LP),U)
32 .I $G(IEN450) D
33 ..S PAYP=$$GET1^DIQ(450,IEN450,20) I $G(PAYP)'="" S PAYP=$$PAYP^OOPSUTL1(PAYP)
34 ..S SAL=$$GET1^DIQ(450,IEN450,28)
35 ..S RET=$$GET1^DIQ(450,IEN450,26) I $G(RET)'="" S RET=$S(RET="FULL CSRS":"CSRS",RET="FERS":"FERS",1:"OTHER")
36 ..S PAY=$$GET1^DIQ(450,IEN450,19) I $G(PAY)'="" S PAY=$S(PAY="PER ANNUM":"ANNUAL",PAY="PER HOUR":"HOURLY","PER DIEM":"DAILY","BIWEEKLY":"BI-WEEKLY",1:"")
37 ..S OCCDESC=$E($$GET1^DIQ(450,IEN450,16),1,30)
38 .S SERV="" I $G(IEN200) S SERV=$$GET1^DIQ(200,IEN200,29)
39 .S RESULTS(LP)=RESULTS(LP)_U_PAY_U_SAL_U_RET_U_PAYP_U_OCCDESC_U_SERV
40 I SAMEFLG,'$D(RESULTS) S RESULTS(0)="^CANNOT CREATE CASE FOR YOURSELF"
41 KILL DIERR,^TMP("DILIST",$J)
42 Q
43 ;
44ASISTS(RESULTS,NAME) ; Lookup on ASISTS Accident Reporting file_2260
45 ; Input: - Name or partial name of person to lookup on
46 ; Output: - array with name of person, sex, DOB, and SSN
47 ;
48 N ARR,I,X,SAMEFLG
49 K ^TMP("DILIST",$J)
50 I NAME="" S RESULTS(0)="^NO SSN OR NAME PROVIDED" Q
51 S X=NAME,SAMEFLG=0
52 ; patch 5 llh - added the 3 indices
53 D FIND^DIC(2260,,"@;1;7;6;5","PSMC",X,500,"C^SSN^BS5")
54 I $G(DIERR) D CLEAN^DILF Q
55 I $P(^TMP("DILIST",$J,0),"^")=0 S RESULTS(1)="^NO ASISTS CASE FOUND" Q
56 F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:I="" D
57 . I DUZ=$P(^TMP("DILIST",$J,I,0),U) S SAMEFLG=1 Q
58 . I $D(ARR($P(^TMP("DILIST",$J,I,0),U,2))) Q
59 . S ARR($P(^TMP("DILIST",$J,I,0),U,2))=""
60 . S RESULTS(I)=^TMP("DILIST",$J,I,0)
61 I SAMEFLG,'$D(RESULTS) S RESULTS(0)="^CANNOT CREATE CASE FOR YOURSELF"
62 I '$D(RESULTS) S RESULTS(0)="^NO SELECTABLE CASES FOUND"
63 K DIERR,^TMP("DILIST",$J)
64 Q
65PER(RESULTS,NAME) ; Lookup for Non-Paid Employee (New Person file_
66 ; Input: - Name or partial name of person to lookup on
67 ; Output: - array with name of new person, sex, DOB, and SSN
68 ;
69 N I,SSN,X,SAMEFLG
70 K ^TMP("DILIST",$J)
71 I NAME="" S RESULTS(0)="^NO SSN OR NAME PROVIDED" Q
72 S X=NAME,SAMEFLG=0
73 D FIND^DIC(200,,"@;.01;4;5;9;29","PSMC",X,500)
74 I $G(DIERR) D CLEAN^DILF Q
75 I $P(^TMP("DILIST",$J,0),"^")=0 S RESULTS(1)="^NO NEW PERSON FOUND" Q
76 F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:I="" D
77 . ; make sure not a PAID Employee
78 . S SSN=$P(^TMP("DILIST",$J,I,0),U,5)
79 . I $G(SSN),$$FIND1^DIC(450,"","MX",SSN) Q
80 . I DUZ=$P(^TMP("DILIST",$J,I,0),U) S SAMEFLG=1 Q
81 . S RESULTS(I)=^TMP("DILIST",$J,I,0)
82 I SAMEFLG,'$D(RESULTS) S RESULTS(0)="^CANNOT CREATE CASE FOR YOURSELF"
83 I '$D(RESULTS) S RESULTS(0)="^NO SELECTABLE CASES FOUND"
84 K DIERR,^TMP("DILIST",$J)
85 Q
86SUPER(RESULTS,NAME,EMPSSN) ; Lookup for Supervisors or anyone from the New
87 ; Person file. This broker call will also be used to
88 ; lookup Union representatives for the Enter/Edit
89 ; Union Information.
90 ; Input: NAME - Name or partial name of person to lookup on
91 ; SSN - SSN of the Person Involved if called from 2162
92 ; Output: RESULTS - array with name of new person, sex, DOB, and SSN
93 ;
94 N I,SSN,SAME,X
95 K ^TMP("DILIST",$J)
96 I NAME="" S RESULTS(1)="^NO SSN OR NAME PROVIDED" Q
97 S X=NAME,SAME=0
98 D FIND^DIC(200,,".01;9","PSCM",X,500)
99 I $G(DIERR) D CLEAN^DILF Q
100 I $P(^TMP("DILIST",$J,0),"^")=0 S RESULTS(1)="^NO NEW PERSON FOUND" Q
101 F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:I="" D
102 . I $G(EMPSSN)'="",($P(^TMP("DILIST",$J,I,0),U,3)=$G(EMPSSN)) S SAME=1 Q
103 . S RESULTS(I)=^TMP("DILIST",$J,I,0)
104 I SAME,'$D(RESULTS) S RESULTS(1)="^CANNOT BE SUPERVISOR FOR YOUR CLAIM"
105 I '$D(RESULTS) S RESULTS(1)="^NO VALID SELECTION"
106 K DIERR,^TMP("DILIST",$J)
107 Q
108 ;
109LOAD(RESULTS,ARR) ; Create new OOPS record
110 ; Input: ARR - contains data entered from the Create Accident/
111 ; Illness Report Option
112 ; Output: RESULTS - status message
113 ;
114 N ASUB,CAT,DA,DATE,DIC,DR,ERROR,FLDS,FNUM,FYEAR,IEN2260,LP,NUM,PCE,SSN,X
115 N LIST,CNT,DLAYGO
116 S CAT=""
117 I $G(ARR(2)) S CAT=ARR(2)
118 I $G(ARR(5)) S SSN=ARR(5)
119 D NOW^%DTC
120 S DATE=X
121 S FYEAR=""
122 S FYEAR=$$FYEAR^OOPSCSN(X)
123 S NUM=$$NEWR^OOPSCSN(FYEAR)
124 K DD,DO
125 S DLAYGO=2260,DIC="^OOPS(2260,"
126 S DIC(0)="QLZ"
127 S X=NUM
128 D FILE^DICN
129 I Y<0 S (RESULTS,RESULTS(0))="UNABLE TO CREATE RECORD" Q
130 S IEN2260=+Y
131 S DIE="^OOPS(2260,"
132 S DA=IEN2260
133 ;
134 S LIST="1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,52,60,63,86,90,335,"
135 S LIST=LIST_"336,338,339,349,350,351,352,"
136 I ARR(52)="Injury" S LIST=LIST_",111,166,167"
137 I ARR(52)="Illness/Disease" S LIST=LIST_",208,334"
138 F CNT=1:1 S FNUM=$P(LIST,",",CNT) Q:FNUM="" I $G(ARR(FNUM))'="" D VAL(DA,FNUM,ARR(FNUM))
139 K DR S DIE="^OOPS(2260,",DA=IEN2260,DR=""
140 S DR(1,2260,1)="1///^S X=ARR(1)"
141 S DR(1,2260,2)="2///^S X=ARR(2)"
142 S DR(1,2260,3)="3///^S X=ARR(3)"
143 S DR(1,2260,4)="4///^S X=ARR(4)"
144 S DR(1,2260,5)="5///^S X=ARR(5)"
145 S DR(1,2260,6)="6///^S X=ARR(6)"
146 S DR(1,2260,7)="7///^S X=ARR(7)"
147 S DR(1,2260,8)="8///^S X=ARR(8)"
148 S DR(1,2260,9)="9///^S X=ARR(9)"
149 S DR(1,2260,10)="10///^S X=ARR(10)"
150 S DR(1,2260,12)="11///^S X=ARR(11)"
151 S DR(1,2260,15)="12///^S X=ARR(12)"
152 S DR(1,2260,18)="13////^S X=ARR(13)" ; sending pointer
153 S DR(1,2260,21)="14///^S X=ARR(14)"
154 S DR(1,2260,24)="15///^S X=ARR(15)"
155 S DR(1,2260,27)="16///^S X=ARR(16)"
156 S DR(1,2260,30)="17///^S X=ARR(17)"
157 S DR(1,2260,33)="18///^S X=ARR(18)"
158 S DR(1,2260,36)="52///^S X=ARR(52)"
159 S DR(1,2260,39)="53////^S X=ARR(53)" ; send pointer
160 S DR(1,2260,42)="53.1////^S X=ARR(22)" ; send pointer
161 S DR(1,2260,45)="56////^S X=ARR(48)" ; send pointer
162 S DR(1,2260,48)="60///^S X=ARR(60)"
163 S DR(1,2260,51)="63///^S X=ARR(63)"
164 S DR(1,2260,54)="86///^S X=ARR(86)"
165 S DR(1,2260,57)="90///^S X=ARR(90)"
166 S DR(1,2260,58)="335///^S X=ARR(169)"
167 S DR(1,2260,59)="336///^S X=ARR(170)"
168 I ARR(52)="Injury" D
169 . S DR(1,2260,60)="111///^S X=ARR(19)"
170 . S DR(1,2260,63)="166///^S X=ARR(166)"
171 . S DR(1,2260,67)="167///^S X=ARR(167)"
172 I ARR(52)="Illness/Disease" D
173 . S DR(1,2260,60)="208///^S X=ARR(19)"
174 . S DR(1,2260,61)="334///^S X=ARR(168)"
175 ; patch 11 - new OSHA 300 questions
176 S DR(1,2260,70)="349///^S X=ARR(171)"
177 S DR(1,2260,71)="339///^S X=ARR(172)"
178 S DR(1,2260,72)="338///^S X=ARR(173)"
179 S DR(1,2260,73)="350///^S X=ARR(174)"
180 S DR(1,2260,74)="351///^S X=ARR(175)"
181 S DR(1,2260,75)="352///^S X=ARR(176)"
182 D ^DIE
183 D CASE^OOPSMBUL(IEN2260) D:(CAT=1)!(CAT=6) BOR^OOPSMBUL(IEN2260):$D(^VA(200,"SSN",SSN))
184 K DR S DIE="^OOPS(2260,",DA=IEN2260,DR="51///0" D ^DIE
185 K DIE,DR,DA
186 S (RESULTS,RESULTS(1))="OK" S:$G(ERROR)]"" (RESULTS,RESULTS(1))=ERROR
187 S RESULTS(2)=$P(^OOPS(2260,IEN2260,0),"^")
188 Q
189 ;
190DELETE ;Delete incomplete case
191 N DIK,DA
192 S DIK="^OOPS(2260,",DA=IEN2260
193 D ^DIK
194 Q
195 ;
196VAL(DA,FIELD,VALUE) ;Validate Input
197 ; Input: DA - IEN of the ASISTS record
198 ; FIELD - field number for data to be validated
199 ; VALUE - data to be validated
200 ; Output:
201 ; none
202 N X
203 D VAL^DIE(2260,DA,FIELD,"",VALUE,.X)
204 I X=U D
205 .S:$G(ERROR)]"" ERROR=ERROR_","
206 .S ERROR=$G(ERROR)_$$GET1^DID(2260,FIELD,"","LABEL")_U_VALUE
207 .; set the data to nil so filing will not bomb
208 .S ARR(FIELD)=""
209 Q
210DUP(RESULTS,SSN) ; Duplicate Case error checking broker call
211 ; Input: INPUT - SSN of current ASISTS case number
212 ; Output: RESULTS - return array with case information
213 ;
214 N CN,DT,IEN,NM,TYPE
215 S IEN="",CN=0
216 S RESULTS(CN)="NO MATCHES FOUND"
217 F S IEN=$O(^OOPS(2260,"SSN",SSN,IEN)) Q:IEN="" D
218 . I $$GET1^DIQ(2260,IEN,51,"I") Q ;case not open, don't include
219 . S NM=$$GET1^DIQ(2260,IEN,1)
220 . S TYPE=$$GET1^DIQ(2260,IEN,"3:.01")
221 . S DT=$$GET1^DIQ(2260,IEN,4)
222 . S RESULTS(CN)=NM_" "_DT_" "_TYPE
223 . S CN=CN+1,(NM,TYPE,DT)=""
224 Q
Note: See TracBrowser for help on using the repository browser.