source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSGUI9.m@ 1556

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

initial load of WorldVistAEHR

File size: 8.2 KB
Line 
1OOPSGUI9 ;WIOFO/LLH-RPC routines ;10/24/01
2 ;;2.0;ASISTS;**6,7**;Jun 03, 2002
3 ;;
4VALIDATE(IEN,FORM,CALLER,VALID) ;
5 ; Input: IEN = Internal Entry Number of entry in file 2260
6 ; FORM = 2162,CA1, or CA2
7 ; CALLER = "E" employee
8 ; = "S" supervisor
9 ; = "O" safety officer
10 ; = "W" worker's comp personnel
11 ; WCEMP = from menu if 1 - need to execute emp validation
12 ; VALID = RESERVED FOR OUTPUT DATA
13 ; Output:VALID = 1 ALL REQUIRED DATA FOR FORM IS COMPLETE
14 ; = 0 DATA IS MISSING
15 N LIST,FLD,CN,CNT,CHK
16 S (FLD,LIST)=""
17 S VALID=1,CHK=0
18 S CN=2 ; start CN in RESULTS array after index 1
19 ; removed code in line below that would also do set if the variable
20 ; WCEMP set. WCEMP was an indicator that WC was completing CA1 for
21 ; employee. May need to do something else. 10/24/01 llh
22 I CALLER="E" D EMP
23 I CALLER="S" D SUP
24 I CALLER="O" D SOF
25 I CALLER="W" D WCP
26 F CNT=1:1 S FLD=$P(LIST,",",CNT) Q:FLD="" D
27 .N LOC,NODE,PCE,BADFLD,TEXT,WP
28 .S BADFLD=1,WP=0
29 .S LOC=$$GET1^DID(2260,FLD,"","GLOBAL SUBSCRIPT LOCATION")
30 .S NODE=$P(LOC,";")
31 .S PCE=$P(LOC,";",2)
32 .I PCE=0 D ;Work processing field
33 ..I '$D(^OOPS(2260,IEN,NODE,1,0)) S (BADFLD,VALID)=0
34 ..S WP=1
35 ..Q
36 .I PCE'=0 I $P($G(^OOPS(2260,IEN,NODE)),U,PCE)="" S (BADFLD,VALID)=0
37 .I 'BADFLD D ; Display error messaged about fields not filled.
38 ..I 'CHK S RESULTS(1)="The following fields must be completed before the "_FORM_" can be signed." S CHK=1
39 ..I WP D ;Is this a wp field and where to get title
40 ...N NODE
41 ...S NODE=2260_".0"_FLD
42 ...; patch 11 - fix bug on fld 40, node '= 2260.040, it's 2260.01
43 ...I FLD=40 S NODE="2260.01"
44 ...S TEXT=$$GET1^DID(NODE,".01","","LABEL")
45 ...Q
46 ..I 'WP S TEXT=$$GET1^DID(2260,FLD,"","LABEL")
47 ..; patch 2.7 if it's body part most affected, indicate the source form
48 ..I FLD=30 S TEXT=$G(TEXT)_" (FORM 2162)"
49 ..S RESULTS(CN)=TEXT,CN=CN+1
50 ..Q
51 .Q
52 ; removed !($G(WCEMP)) which indicates validation coming from WC
53 ; completing the employee portion of the CA1. May need to figure
54 ; something else out. 10/24/01 llh
55 I FORM="CA1"&(CALLER="E") D ; fld 110 check on Emp CA1 only
56 . I $$GET1^DIQ(2260,IEN,110,"I")<($$GET1^DIQ(2260,IEN,4,"I")\1) S VALID=0 D
57 .. S RESULTS(CN)=$$GET1^DID(2260,110,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,4,"","LABEL"),CN=CN+1
58DTCHK ; Date error checking that may be missed w/input transform
59 ; patch 11 - Additional error checking has been added for CA2 field 214
60 ; removed $G(WCEMP) from line below. same concern as above 10/24/01 llh
61 I FORM=2162!(CALLER="O") Q
62 K CNT,FLD,LIST
63 N DATE,DATE1,DATE2,TITLE,EMPDOB
64 ; patch 11 - need to make sure 215 not before 214 on employee part
65 I CALLER="E",FORM="CA2" D Q
66 . S DATE1=$$GET1^DIQ(2260,IEN,215,"I")
67 . S DATE2=$$GET1^DIQ(2260,IEN,214,"I")
68 . S EMPDOB=$$GET1^DIQ(2260,IEN,6,"I")
69 . I $$FMDIFF^XLFDT(DATE2,EMPDOB,2)<0 S VALID=0 D
70 .. S RESULTS(CN)=$$GET1^DID(2260,214,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,6,"","LABEL"),CN=CN+1
71 . I $$FMDIFF^XLFDT(DATE1,DATE2,2)<0 S VALID=0 D
72 .. S RESULTS(CN)=$$GET1^DID(2260,215,"","LABEL")_" must be on or after the "_$$GET1^DID(2260,214,"","LABEL"),CN=CN+1
73 ; End of checks from Employee CA2
74 I FORM="CA1" D
75 . S LIST="142,161,175"
76 . S (DATE,DATE1)=$$GET1^DIQ(2260,IEN,4,"I")
77 . S TITLE=$$GET1^DID(2260,4,"","LABEL")
78 I FORM="CA2" D
79 . S LIST="215,250,252,253,255"
80 . S (DATE,DATE1)=$$GET1^DIQ(2260,IEN,214,"I")
81 . S TITLE=$$GET1^DID(2260,214,"","LABEL")
82 F CNT=1:1 S FLD=$P(LIST,",",CNT) Q:FLD="" D
83 . S DATE2=$$GET1^DIQ(2260,IEN,FLD,"I") I FLD'=142 S DATE2=DATE2\1,DATE1=DATE\1
84 . I $G(DATE2),DATE2<DATE1 D S VALID=0
85 .. S RESULTS(CN)=$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE,CN=CN+1
86 ; Need specific check on DATE/TIME STOPPED WORK
87 I FORM="CA1" D
88 . S LIST="143,144,145",DATE=$$GET1^DIQ(2260,IEN,142,"I")
89 . S TITLE=$$GET1^DID(2260,142,"","LABEL")
90 I FORM="CA2" D
91 . S LIST="254,256",DATE=$$GET1^DIQ(2260,IEN,253,"I")
92 . S TITLE=$$GET1^DID(2260,253,"","LABEL")
93 F CNT=1:1 S FLD=$P(LIST,",",CNT) Q:FLD="" D
94 . S DATE2=$$GET1^DIQ(2260,IEN,FLD,"I"),DATE1=DATE D
95 .. I FLD=143!(FLD=144) S DATE1=DATE\1,DATE2=DATE2\1
96 .. I (DATE1>DATE2),$G(DATE2) D S VALID=0
97 ... S RESULTS(CN)=$$GET1^DID(2260,FLD,"","LABEL")_" must be on or after the "_TITLE,CN=CN+1
98 .. I '$G(DATE1),$G(DATE2) D S VALID=0
99 ... S RESULTS(CN)=TITLE_" cannot be blank if date in "_$$GET1^DID(2260,FLD,"","LABEL"),CN=CN+1
100 Q
101EMP ; Address fields are now all pulled from the 2162A node
102 ; added fields 126 & 181,183-185 to lists below - patch 8
103 I FORM="CA1" S LIST="8,9,10,11,12,108,109,110,111,112,113,114,126,181,183,184,185"
104 ; added field 213 - ASISTS V2.0
105 I FORM="CA2" S LIST="8,9,10,11,12,126,208,209,213,214,215,216,217"
106 Q
107SUP ;
108 N F165
109 I FORM="2162" D F2162 Q
110 S LIST="30,"
111 I FORM="CA1" D
112 . S LIST=LIST_"4,60,130,131,132,133,134,138,139,140,146,148,150,"
113 . S LIST=LIST_"162,163,172,173,174,175,176,177,178,179,"
114 . S LIST=LIST_"180,181,183,184,185,"
115 . I $$GET1^DIQ(2260,IEN,150,"I")="Y" S LIST=LIST_"151,152,153,154,155,"
116 . ; V2.0 added required fields missed in patch 8
117 . I $$GET1^DIQ(2260,IEN,146)="No" S LIST=LIST_"147,"
118 . I $$GET1^DIQ(2260,IEN,148)="Yes" S LIST=LIST_"149,"
119 . I $$GET1^DIQ(2260,IEN,163)="No" S LIST=LIST_"164,"
120 . S F165=$G(^OOPS(2260,IEN,"CA1K",0))
121 . I $G(F165)'="",($P(F165,U,4)'=0) S LIST=LIST_"165,"
122 I FORM="CA2" D
123 . S LIST=LIST_"230,231,232,233,234,237,238,239,240,241,"
124 . S LIST=LIST_"242,243,244,251,252,255,258,60,268,269,"
125 . ; below for ASISTS V2.0, needed for roll and scroll also
126 . ; added next line, need to get 3rd party if 258 = y
127 . I $$GET1^DIQ(2260,IEN,258,"I")="Y" S LIST=LIST_"259,260,261,262,263,"
128 ; V2.0 if field 60="other" (3) then 61 required for both CA1 & CA2
129 I $$GET1^DIQ(2260,IEN,60,"I")=3 S LIST=LIST_"61,"
130 ; need to check Physician information for both CA1 and CA2
131 D PHYCHK
132 Q
133PHYCHK ; checks physician fields for appropriate form. If Phy Name not
134 ; blank address fields required. If Phy Name blank and data in any
135 ; address field then all fields required.
136 N CTR,FLD,PHY,PLIST,NBLK
137 S NBLK="",PHY=$S(FORM="CA1":156,FORM="CA2":245,1:"")
138 I 'PHY Q
139 S PLIST=$S(PHY=156:"157,158,159,160,182",PHY=245:"246,247,248,249,270",1:"")
140 I PLIST="" Q
141 I PHY=156 D Q
142 . I $$GET1^DIQ(2260,IEN,156)'="" D Q
143 .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)="" S LIST=LIST_FLD_","
144 . I $$GET1^DIQ(2260,IEN,156)="" D Q
145 .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)'="" S NBLK=NBLK_FLD_","
146 .. I $G(NBLK)'="" S LIST=LIST_"156," F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I '$F(NBLK,FLD) S LIST=LIST_FLD_","
147 I PHY=245 D Q
148 . I $$GET1^DIQ(2260,IEN,245)'="" D Q
149 .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)="" S LIST=LIST_FLD_","
150 . I $$GET1^DIQ(2260,IEN,245)="" D
151 .. F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I $$GET1^DIQ(2260,IEN,FLD)'="" S NBLK=NBLK_FLD_","
152 .. I $G(NBLK)'="" S LIST=LIST_"245," F CTR=1:1 S FLD=$P(PLIST,",",CTR) Q:FLD="" I '$F(NBLK,FLD) S LIST=LIST_FLD_","
153 Q
154SOF ; the call to F2162 here is overkill. All these fields should
155 ; already be completed, but just in case...
156 ; removed field 89 from required list for patch 7
157 I FORM="2162" D F2162 S LIST=LIST_",55,88"
158 ; code below obsolete with patch 7
159 ;I $$ISEMP^OOPSUTL4(IEN) D
160 ;.S LIST=LIST_",33"
161 ;.I $$GET1^DIQ(2260,IEN,33)="N" S LIST=LIST_",32"
162 Q
163WCP ; Get required fields for Workers Comp
164 I FORM="2162" D F2162 Q
165 S LIST="5,6,7,15,62,70,73,"
166 I FORM="CA1" D
167 . S LIST=LIST_"123,124,"
168 . ; flds 166 & 167 only required if personnel status = 1
169 . I $$GET1^DIQ(2260,IEN,2,"I")=1 S LIST=LIST_"166,167,"
170 I FORM="CA2" D
171 . S LIST=LIST_"226,227,"
172 D SUP
173 Q
174F2162 ; Set required fields for form 2162
175 N TYP,SAF,INCID
176 I FORM'="2162" Q
177 S LIST="26,27,28,29,30,31"
178 S TYP=$$GET1^DIQ(2260,IEN,"3:.01","E")
179 I "^Sharps Exposure^Hollow Bore Needlestick^Suture Needlestick^"[TYP D
180 . S LIST=LIST_",34,35,36,37,38,82"
181 I $$GET1^DIQ(2260,IEN,"38:2","I")="N" S LIST=LIST_",83"
182 I "^Exposure to Body Fluids/Splash^"[TYP D
183 . S LIST=LIST_",34,39,40,41"
184 S INCID=$$GET1^DIQ(2260,IEN,3,"I")
185 I (INCID<11)!(INCID>14) Q
186 I $$GET1^DIQ(2260,IEN,42.5,"I")="Y" S LIST=LIST_",42"
187 S SAF=$$GET1^DIQ(2260,IEN,43,"I")
188 S LIST=$S(SAF="Y":LIST_",84,87",SAF="N":LIST_",85",1:LIST)
189 S LIST=LIST_",47"
190 Q
Note: See TracBrowser for help on using the repository browser.