source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSSUP3.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1OOPSSUP3 ;HINES/WAA-S/E Supervisor Edit routine 2162 ;04/15/1998
2 ;;2.0;ASISTS;;Jun 03, 2002
3 ;;
4ASIST ; 2162 FORM
5 N INCID,SUP,CAT,OBJ,IEN200
6 S INCID=$$GET1^DIQ(2260,IEN,3,"I")
7 S:INCID'="" INCID=$$GET1^DIQ(2261.2,INCID,.01,"E") ; Getting the type of incident
8 S INCID=U_INCID_U
9 ; Allow edit of supervisor, secondary supervisor
10 ; Also, include logic for Non-PAID employee
11 S CAT=$$GET1^DIQ(2260,IEN,2,"I")
12 ; Patch 5 - added logic for employee CAT >6
13 S SUP=$S((CAT=1!(CAT>6)):" SUPERVISOR...............",CAT=2:" VOLUNTARY SVC SUPERVISOR.",CAT=3:" CONTRACT ADMINISTRATOR...",1:" SAFETY OFFICER...........")
14 ; Patch 11 - get service, renumber DR array, add new prompts
15 S IEN200=$$GET1^DIQ(2260,IEN,5,"I"),SER=""
16 I $G(IEN200)'="" S IEN200=$O(^VA(200,"SSN",IEN200,""))
17 I $G(IEN200)'="" S SER=$$GET1^DIQ(200,IEN200,29,"I")
18 S DR=""
19 S DR(1,2260,1)="86////^S X=SER"
20 S DR(1,2260,2)="53"_SUP
21 S DR(1,2260,5)="53.1 SECONDARY SUPERVISOR....."
22 S DR(1,2260,10)="26 GENERAL SETTING OF INCIDENT........;S X=X;"
23 S DR(1,2260,15)="27 LOCATION OF INJURY.................;S X=X;D CARE2^OOPSUTL2(IEN);"
24 S DR(1,2260,20)="28 DESCRIPTION OF INCIDENT............"
25 ; Patch 5 - added line below
26 S DR(1,2260,25)="29.5 HOW IS INCIDENT RELATED TO MEDICAL EMERGENCY"
27 S DR(1,2260,30)="29 CHARACTERIZATION OF INJURY........."
28 S DR(1,2260,35)="30 BODY PART MOST AFFECTED............"
29 S DR(1,2260,40)="30.1 ADDITIONAL BODY PART AFFECTED......"
30 S DR(1,2260,45)="31 SIDE OF BODY AFFECTED..............;S X=X;"
31SHARPS ; SHARPS DATA
32 ; Patch 5 - added Suture Needlestick
33 I "^Sharps Exposure^Hollow Bore Needlestick^Suture Needlestick^"'[INCID G FLUID
34 S DR(1,2260,50)="34 PATIENT SOURCE....................."
35 S DR(1,2260,55)="35 CONTAMINATION......................"
36 S DR(1,2260,60)="36 PURPOSE OF SHARP OBJECT..........."
37 S DR(1,2260,65)="37 ACTIVITY AT TIME OF INJURY........"
38 S DR(1,2260,70)="38 OBJECT CAUSING INJURY.............;S X=X;"
39 S DR(1,2260,80)="S OBJ=$$GET1^DIQ(2260,IEN,""38:2"",""I"")"
40 S DR(1,2260,85)="I OBJ'=""N"" S Y=""@1"""
41 S DR(1,2260,90)="83 DEVICE SIZE......................."
42 S DR(1,2260,95)="S Y=""@2"""
43 S DR(1,2260,100)="@1"
44 S DR(1,2260,105)="83////@" ; delete if OBJ'="N" or "S"
45 S DR(1,2260,110)="@2"
46 S DR(1,2260,115)="82 BRAND............................."
47 G ALL
48FLUID ; Body Fluid Exposer
49 I "^Exposure to Body Fluids/Splash^"'[INCID G EVERY
50 S DR(1,2260,115)="34 PATIENT SOURCE....................."
51 S DR(1,2260,120)="39" ; Multiple, DD prompt used - P5
52 S DR(1,2260,125)="40" ; Multiple, DD prompt used - P5
53 S DR(1,2260,130)="41 BODILY FLUID EXPOSURE SOURCE......."
54ALL ; ALL TYPE OF EXPOSURES
55 ; Patch 5 - Changed logic
56 S FAIL=$$GET1^DIQ(2260,IEN,42.5,"E") I FAIL="" S FAIL="No"
57 S DR(1,2260,135)="42.5 WAS THERE AN EQUIPMENT/DEVICE/PRODUCT FAILURE//^S X=FAIL;I X=""N"" S Y=""@3"""
58 S DR(1,2260,140)="42 DESCRIBE EQUIPMENT/DEVICE/PRODUCT FAILURE.."
59 S DR(1,2260,145)="S Y=43"
60 S DR(1,2260,150)="@3"
61 S DR(1,2260,155)="42////@"
62 S DR(1,2260,160)="43 SAFETY DESIGN DEVICE USED....;S X=X;"
63 ; started adding for patch 11
64 S DR(1,2260,165)="S Y=$S(X=""Y"":""@4"",X=""N"":""@5"",1:""@6"")"
65 S DR(1,2260,170)="@4"
66 S DR(1,2260,172)="85////@"
67 S DR(1,2260,175)="87 DID THE INJURY OCCUR BEFORE THE SAFETY DEVICE WAS ENGAGED.."
68 S DR(1,2260,180)="84 SAFETY CHARACTERISTICS......."
69 S DR(1,2260,185)="S Y=""@6"""
70 S DR(1,2260,190)="@5"
71 S DR(1,2260,195)="84////@"
72 S DR(1,2260,197)="87////@"
73 S DR(1,2260,200)="85 EXPLAIN WHY A SAFETY DEVICE WAS NOT USED..."
74 S DR(1,2260,205)="@6"
75EVERY ; All Employees
76 ; Include CAT=6 Non-PAID employee as employee
77 I $$ISEMP^OOPSUTL4(IEN) D
78 .S DR(1,2260,210)="32 DUTY RETURNED TO..................."
79 .S DR(1,2260,215)="33 LOST TIME..........................;S X=X;"
80 .Q
81 S DR(1,2260,220)="47 CORRECTIVE ACTION............"
82 Q
Note: See TracBrowser for help on using the repository browser.