source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSUTL2.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: 6.7 KB
Line 
1OOPSUTL2 ;HINES/WAA-Utilities Routines ;3/24/98
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4CARE2(IEN) ; Update location field
5 N LOC,GEN
6 S GEN=$$GET1^DIQ(2260,IEN,27,"I")
7 S LOC=$$GET1^DIQ(2261.4,GEN,2,"I")
8 S $P(^OOPS(2260,IEN,"2162B"),U,1)=LOC
9 Q
10VCHAR ; Write error message if invalid character
11 W !,"Invalid character entered (~,`,@,#,$,%,*,_,|,\,},{,[,],>, or <)",!,"please edit.",!
12 Q
13DEVSZ(IEN,DEV) ; This screens responses to the DEVICE SIZE table based on whether
14 ; the OBJECT CAUSING INJURY field contains the word Needle or Syringe
15 ;
16 ; Input: IEN - Internal Record Number of claim
17 ; DEV - Internal Record Number in ^OOPS(2262.2)
18 ; Output: VIEW - if 1, can select, if 0, not available
19 ;
20 N OBJECT,VIEW
21 S VIEW=0
22 S OBJECT=$$UP^OOPSUTL4($$GET1^DIQ(2260,IEN,38))
23 S TYPE=$$GET1^DIQ(2262.2,DEV,1,"I")
24 I (OBJECT["NEEDLE")&(TYPE="N"!(TYPE="NS")) S VIEW=1
25 I (OBJECT["SYRINGE")&(TYPE="S"!(TYPE="NS")) S VIEW=1
26 Q VIEW
27EQUIP() ; This will ask if the product failed
28 N ANS,DIR,Y
29 S ANS=0
30 S DIR(0)="YO^"
31 S ANS=0,DIR("B")=$S($P($G(^OOPS(2260,IEN,"2162D")),U,7)'="":"YES",1:"NO")
32 S DIR("A")="WAS THERE AN EQUIPMENT/DEVICE/PRODUCT FAILURE"
33 S DIR("?")="Enter Yes or No to indicate that it was a failure of an device."
34 D ^DIR
35 I Y=1 S ANS=1
36 I ANS'=1,$P($G(^OOPS(2260,IEN,"2162D")),U,7)'="" S $P(^("2162D"),U,7)=""
37 Q ANS
38DISP ; disp text for prompt
39 W !,"Was the exposed part:"
40 W !," Skin,"
41 W !," Eyes(Conjunctiva),"
42 W !," Nose(mucosa),"
43 W !," Mouth(mucosa)"
44 W !," Other"
45 W !
46 Q
47CARE(IEN,GEN) ; Select Patient Care Area
48 N AREA,TYPE,VIEW
49 S VIEW=0
50 S AREA=$$GET1^DIQ(2260,IEN,26,"I")
51 I AREA="" S AREA="U"
52 I AREA="U" S VIEW=1
53 E D
54 .S TYPE=$$GET1^DIQ(2261.4,GEN,2,"I")
55 .I AREA=TYPE S VIEW=1
56 .Q
57 Q VIEW
58 ;
59 N AREA,OTHER
60 N SELECT,DIR,Y,DEFAULT,INC
61 S INC=$$GET1^DIQ(2260,IEN,52,"I")
62 S SELECT=""
63 ;W !
64 ;W !," Select the Area Type:",!
65 ;W !," 1) Patient"
66 ;W !," 2) Non-patient"
67 ;W !," 3) Unknown",!
68 S DIR(0)="SAO^1:Patient;2:Non-patient;3:Unknown"
69 S DIR("A")="GENERAL SETTING OF "_$S(INC=1:"INJURY",INC=2:"ILLNESS",1:"")_": "
70 S DIR("?")="Select the area type to be used."
71 S SELECT=$$GET1^DIQ(2260,IEN,27,"I")
72 S SELECT=$S(SELECT'="":$$GET1^DIQ(2261.4,SELECT,2,"I"),1:"")
73 S:SELECT'="" SELECT=$S(SELECT="P":"Patient",SELECT="N":"Non-patient",1:"")
74 S:SELECT'="" DIR("B")=SELECT
75 D ^DIR
76 I $D(DTOUT)!($D(DUOUT)) S Y(0)="",AREA=-1
77 S (OTHER,AREA)=$S(Y(0)="Patient":"P",Y(0)="Non-patient":"N",Y(0)="Unknown":"",1:"-1")
78 I AREA'=-1 D
79 .I AREA'="",$E(AREA,1)=$E(SELECT,1) S DEFAULT=$$GET1^DIQ(2261.4,$$GET1^DIQ(2260,IEN,27,"I"),.01,"E")
80 .D
81 ..N DIC,X
82 ..S DIC="^OOPS(2261.4,"
83 ..I AREA'="" S DIC("S")="I $$GET1^DIQ(2261.4,Y,2,""I"")=AREA"
84 ..I $D(DEFAULT) S DIC("B")=DEFAULT
85 ..S DIC("A")=$S(AREA="P":"PATIENT ",AREA="N":"NON-PATIENT ",1:" ")_"CARE AREA: ",DIC(0)="AQEMNZ"
86 ..D ^DIC
87 ..I $D(DTOUT)!($D(DUOUT)) S AREA=-1 Q
88 ..I Y<1 S AREA=-1 Q
89 ..S AREA=$P(Y,U)
90 ..Q
91 .Q
92 I AREA>0 S AREA=AREA_U_OTHER
93 Q AREA
94SAFETY(IEN,OPEN) ; Safety Officer Screen
95 N VIEW
96 S VIEW=0,OPEN=$G(OPEN,0)
97 ;I FORM=
98 I OPEN,'$P(^OOPS(2260,IEN,0),U,6) S VIEW=1
99 I 'OPEN,$P(^OOPS(2260,IEN,0),U,6)'=2,$P($$EDSTA^OOPSUTL1(IEN,"S"),U,3) S VIEW=1
100 Q VIEW
101SUPSCR(SUP,IEN,OPEN) ; Supervisor screen
102 ; Input
103 ; SUP the DUZ of the Supervisor
104 ; IEN the IEN of the ENTRY in file 2260
105 ;
106 ; Output
107 ; VIEW 1 Sup can see
108 ; 0 Sup can't see
109 N VIEW
110 S VIEW=0,OPEN=$G(OPEN,0)
111 I $$OPEN^OOPSUTL1(IEN,OPEN) D ;Form can be selected
112 .N INJ
113 .S INJ=$$GET1^DIQ(2260,IEN,52,"I")
114 .I ($$GET1^DIQ(2260,IEN,53,"I")'=DUZ)&($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ) Q ; Not the Primary or secondary super
115 .I $$EDSTA^OOPSUTL1(IEN,"O") Q
116 .; ^^^ 2162 has been signed by the Safety Officer
117 .
118 .I ($P($$EDSTA^OOPSUTL1(IEN,"S"),U,INJ)),($P($$EDSTA^OOPSUTL1(IEN,"S"),U,3)) Q ; Form can not be selected because both
119 . ;the 2162 and the CA1/2 have been signed
120 .S VIEW=1
121 .Q
122 Q VIEW
123AGNINFO ;Patch 7 - default Agency info if available
124 S AIEN=$P(^OOPS(2260,IEN,"2162A"),"^",9)
125 S AGN=$$GET1^DIQ(4,AIEN,.01,"E")
126 S ADD=$$GET1^DIQ(4,AIEN,1.01,"E")
127 S CITY=$$GET1^DIQ(4,AIEN,1.03,"E")
128 S STATE=$$GET1^DIQ(4,AIEN,.02,"E")
129 S ZIP=$$GET1^DIQ(4,AIEN,1.04,"E")
130 Q
131PHINFO ;Patch 7 - default physician data, if available
132 S STAT=0
133 S AIEN=$P(^OOPS(2260,IEN,"2162A"),"^",9)
134 ; get physician data for correct STATION
135 F S STAT=$O(^OOPS(2262,1,1,STAT)) Q:STAT'>0 I ($P(^OOPS(2262,1,1,STAT,0),"^")=AIEN) Q ;found match, quit
136 I STAT D
137 .S SIEN=STAT_",1,"
138 .S PNAME=$$GET1^DIQ(2262.03,SIEN,1)
139 .S PADD=$$GET1^DIQ(2262.03,SIEN,2)
140 .S PCITY=$$GET1^DIQ(2262.03,SIEN,3)
141 .S PSTATE=$$GET1^DIQ(2262.03,SIEN,4)
142 .S PZIP=$$GET1^DIQ(2262.03,SIEN,5)
143 .S PTITLE=$$GET1^DIQ(2262.03,SIEN,"6:1")
144 Q
145RWS ;Regular Work Schedule
146 N Y S DIR(0)="LA^1:7"
147 S DIR("?",1)=" Enter the employee's work schedule at the time of the incident."
148 S DIR("?",2)=" The numbers 1-7 correspond to the days of the week."
149 S DIR("?",3)=" 1 = Sunday"
150 S DIR("?",4)=" 2 = Monday"
151 S DIR("?",5)=" 3 = Tuesday"
152 S DIR("?",6)=" 4 = Wednesday"
153 S DIR("?",7)=" 5 = Thursday"
154 S DIR("?",8)=" 6 = Friday"
155 S DIR("?",9)=" 7 = Saturday"
156 S DIR("?",10)=" Enter the day numbers as a range or list separated by commas."
157 S DIR("?",11)=""
158 S DIR("?",12)=" Examples: For Mon-Fri enter 2-6 (or 2,3,4,5,6)"
159 S DIR("?",13)=" For Wed-Sat enter 4-7 (or 4,5,6,7)"
160 S DIR("?")=" For Mon,Wed,Fri enter 2,4,6"
161 D ^DIR
162 I $P(X,"-",2)>7 W !," Range exceeds 1-7 limit." G RWS
163 Q:$D(DIRUT)
164 S:ITEM=21 $P(^OOPS(2260,D0,"CA1F"),U,11)=Y
165 S:ITEM=22 $P(^OOPS(2260,D0,"CA2I"),U,8)=Y
166 Q
167EXCEPT ; Exception statement
168 W !," ",ITEM,". A supervisor who knowingly certifies to any false statement,"
169 W !," misrepresentation, concealment of fact, etc., in respect of"
170 W !," this claim may also be subject to appropriate felony criminal"
171 W !," prosecution."
172 W !
173 W !," I certify that the information given above and that furnished"
174 W !," by the employee is true to the best of my knowledge with the"
175 W !," following exception."
176 W !
177 Q
178MKNUM(INSTR) ; Strip/Convert num numerics from a string - Patch 11
179 ; Input - INSTR - Character String that should be a number
180 ; Output - NUMOUT - String stripped of all non-numeric characters.
181 N K,NUMOUT
182 S NUMOUT=""
183 F K=1:1:$L(INSTR) I ($A(INSTR,K)>47)&($A(INSTR,K)<58) S NUMOUT=NUMOUT_$E(INSTR,K)
184 Q NUMOUT
185RWSOT ;Regular Work Schedule output transform
186 N I,HOLD
187 S HOLD=""
188 F I=1:1:($L(Y)/2) S HOLD=HOLD_$P("Sun,Mon,Tue,Wed,Thu,Fri,Sat",",",$P(Y,",",I))_","
189 S Y=$E(HOLD,1,($L(HOLD)-1))
190 Q
191UNION(IEN) ;
192 ; Input: IEN = Internal Entry Number of entry in file 2260
193 ; Output VALID = 1 Valid to be seen by Union
194 ; = 0 Not Valid to be seen by Union
195 N VALID
196 S VALID=0
197 I $$EDSTA^OOPSUTL1(IEN,"O"),$P($$EDSTA^OOPSUTL1(IEN,"S"),U,3) S VALID=1
198 Q VALID
Note: See TracBrowser for help on using the repository browser.