close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSGUIT.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSGUIT.m@ 861

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

initial load of WorldVistAEHR
File size: 9.4 KB
RevLine 
1OOPSGUIT ;WIOFO/LLH-RPC Rtn for Type of Incident rpt ;11/5/01
2 ;;2.0;ASISTS;**4,7,11**;Jun 03, 2002
3 ;
4ENT(RESULTS,TRPT,CSTAT,STDT,ENDDT,LTNTT,STAT,PSTAT) ;
5 N DATA,CNT,CS,CS1,EDATE,OOPS,LOST,LP,SDATE,TOT,RPTTY
6 N STATION,LOSTTIME,NODE,OOPDA,PER,X,Y
7 S RPTTY=$$REPORT(),CS=$S(CSTAT="O":0,CSTAT="C":1,1:"")
8 S LOST=$S(LTNTT="L":"Y",1:""),(SDATE,EDATE)=""
9 S X=STDT D ^%DT S SDATE=Y,X=ENDDT D ^%DT S EDATE=Y
10 S SDATE=(SDATE-1)_".9999",EDATE=EDATE_".9999",LP="",OOPDA=""
11 F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE) D
12 .F S OOPDA=$O(^OOPS(2260,"AD",LP,OOPDA)) Q:OOPDA'>0 D
13 ..S OOPS(0)=$G(^OOPS(2260,OOPDA,0))
14 ..S CS1=$P(OOPS(0),U,6)
15 ..I $G(CS1)>1 Q ; only open & closed cases
16 ..I (CS'=""),(CS'=CS1) Q ; if 'All cases, case status must match
17 ..S PER=$$GET1^DIQ(2260,OOPDA,2,"I")
18 ..I (+PSTAT)&(PSTAT'[(PER_"^")) Q
19 ..S STATION=$$GET1^DIQ(2260,OOPDA,13,"I")
20 ..I STAT'="A",(STATION'=STAT) Q
21 ..S LOSTTIME=""
22 ..I $O(^OOPS(2260,OOPDA,"OUTC","AC","A","A","")) S LOSTTIME="Y"
23 ..I LOST="Y",(LOSTTIME'="Y") Q
24 ..I RPTTY=3 D
25 ...N INC S INC=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
26 ...I $G(INC)="" S INC="Unknown"
27 ...S:$D(DATA(INC))=0 DATA(INC)=0 S DATA(INC)=DATA(INC)+1
28 ..I RPTTY=15 D
29 ...N DIC,DR,DA,DIQ,FLD,NAME,OCC,IEN450,X,Y
30 ...S NAME=$$GET1^DIQ(2260,OOPDA,1),FLD=16
31 ...S DIC="^PRSPC(",DIC(0)="Z",X=NAME D ^DIC
32 ...I Y>0 D
33 ....K DIQ S DR=FLD,DA=+Y,IEN450=+Y,DIQ="OOPS",DIQ(0)="IE"
34 ....D EN^DIQ1 K DIQ
35 ...S OCC=$$GET1^DIQ(2260,OOPDA,15,"I")
36 ...I $G(IEN450),$G(OCC)'="",(OCC=$E($G(OOPS(450,IEN450,FLD,"I")),1,4)) D
37 ....S OCC=OCC_" - "_OOPS(450,IEN450,FLD,"E")
38 ...I $G(OCC)="" S OCC="Unknown"
39 ...S:$D(DATA(OCC))=0 DATA(OCC)=0 S DATA(OCC)=DATA(OCC)+1
40 ..I RPTTY=29 D
41 ...N CHAR S CHAR=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
42 ...I $G(CHAR)="" S CHAR="Unknown"
43 ...S:$D(DATA(CHAR))=0 DATA(CHAR)=0 S DATA(CHAR)=DATA(CHAR)+1
44 ..I RPTTY=86 D
45 ...N SERV S SERV=$$GET1^DIQ(2260,OOPDA,RPTTY_":.01")
46 ...I $G(SERV)="" S SERV="Unknown"
47 ...S:$D(DATA(SERV))=0 DATA(SERV)=0 S DATA(SERV)=DATA(SERV)+1
48 ..I RPTTY=30 D
49 ...N BODY S BODY=$$GET1^DIQ(2260,OOPDA,RPTTY_":1")
50 ...F I=1:1 Q:$P($T(BODY+I),";",3)="Q" I $P($T(BODY+I),";",4)[(U_BODY_U) S BODY=$P($T(BODY+I),";",3) Q
51 ...I $G(BODY)="" S BODY="Unknown"
52 ...S:$D(DATA(BODY))=0 DATA(BODY)=0 S DATA(BODY)=DATA(BODY)+1
53 ..I RPTTY=999 D
54 ...N DOI,DOW
55 ...S DOI=$$GET1^DIQ(2260,OOPDA,4,"I"),DOW=$$DOW^XLFDT(DOI)
56 ...S DOW=$S(DOW="Friday":"6Friday",DOW="Monday":"2Monday",DOW="Saturday":"7Saturday",DOW="Sunday":"1Sunday",DOW="Thursday":"5Thursday",DOW="Tuesday":"3Tuesday",DOW="Wednesday":"4Wednesday",1:"Unk")
57 ...I $G(DOI)="" S DOI="Unknown"
58 ...S:$D(DATA(DOW))=0 DATA(DOW)=0 S DATA(DOW)=DATA(DOW)+1
59 ..I RPTTY=9999 D
60 ...N LABEL,TDOI,TIME S TDOI=$P($$GET1^DIQ(2260,OOPDA,4),"@",2)
61 ...I $G(TDOI)="" S TDOI="Unknown"
62 ...I TDOI'="Unknown" D
63 ....I +$P(TDOI,":")&($P(TDOI,":")'=24) S TIME=$P(TDOI,":")
64 ....E S TIME=24
65 ....S LABEL=TIME_":"_"00 - "_TIME_":59"
66 ...I TDOI="Unknown" S LABEL="Unknown"
67 ...S:$D(DATA(LABEL))=0 DATA(LABEL)=0 S DATA(LABEL)=DATA(LABEL)+1
68 S TOT=1,NODE="",CNT=0
69 F S NODE=$O(DATA(NODE)) Q:NODE="" S RESULTS(TOT)=NODE_"^"_DATA(NODE),CNT=CNT+$P(RESULTS(TOT),U,2),TOT=TOT+1
70 I CNT S RESULTS(0)=CNT
71 Q
72REPORT() ; Get Fld # to sort on
73 I TRPT="Type of Incidents" S RPTTY=3
74 I TRPT="Occupation Code" S RPTTY=15
75 I TRPT="Characterization of Injury" S RPTTY=29
76 I TRPT="Service" S RPTTY=86
77 I TRPT="Body Parts" S RPTTY=30
78 I TRPT="Day of Week" S RPTTY=999
79 I TRPT="Time of Day" S RPTTY=9999
80 Q RPTTY
81BODY ; group the body parts to min # of columns
82 ;;Abdomen;^BA^V5^VI^V4^V3^VL^VM^VS^
83 ;;Arm(s) Lower;^AS^AB^A4^A6^A3^A5^
84 ;;Arm(s) Upper;^AX^AZ^A2^A1^
85 ;;Back (Lumbar Region);^BL^
86 ;;Back (Upper);^BU^
87 ;;Chest;^BC^RS^
88 ;;Ear(s);^H4^C2^H3^C1^
89 ;;Elbow;^EB^ES^
90 ;;Eye(s);^H2^C4^H1^C3^
91 ;;Face;^CK^HC^HF^CJ^HM^CM^HN^CN^CD^CT^
92 ;;Foot,Includes Toes;^PB^G2^G3^G4^PS^G1^
93 ;;Hand(s),Includes fingers;^F2^F8^MB^F4^F6^TB^FB^FS^F1^F7^MS^F3^F5^TS^
94 ;;Knees;^KB^KS^
95 ;;Leg(s), lower;^L4^L3^
96 ;;Leg(s), upper;^LX^LZ^
97 ;;Neck;^HK^CL^CR^
98 ;;Not Elsewhere Classified;^XZ^L2^LB^BZ^XX^VN^RP^LS^L1^
99 ;;Reproductive Organs;^B2^B4^BP^VR^B1^B3^B5^
100 ;;Ribs;^RB^RC^
101 ;;Shoulder;^R2^R4^SB^R1^R3^SS^
102 ;;Skull/Head;^CB^HX^HZ^CX^CZ^HS^CC^CS^
103 ;;Spinal Cord;^VC^RV^
104 ;;Thorax;^VH^V2^V1^
105 ;;Trunk;^BS^RZ^BX^VX^VZ^RX^BW^
106 ;;Q
107 Q
108ACCID(RESULTS,INPUT,CALL) ; Print Accident Report Status report - get data
109 ; Input: INPUT - START,END DATE, & STATION. Format is STARTDATE^
110 ; ENDDATE^STA^CASESTATUS. STA is A or IEN of station,
111 ; case status = open 'O', closed 'C', or both 'A'.
112 ; CALL - calling menu. Excludes name if called from Union menu
113 ; Output: - RESULTS contains the data to be displayed in the report
114 N ARR,CN,IEN,SDATE,SIGN,SIGSTR,STDT,STA,ENDDT,EDATE,X,Y,SUPSTR,EMPSTR
115 N CASE,CAT,DOI,EMP,INC,ISEMP,PERSON,SAF,SSN,SSN1,SP,SUP,WCP,PCE
116 ; patch 4 llh - select by case status ; patch 11, get super's name
117 N CS,STATUS,SUPER,S48,S6,S20,S12
118 S S48=" "
119 S S6=" ",S12=" ",S20=" "
120 K ^TMP($J,"ACCID")
121 S CN=1,RESULTS(0)="Processing..."
122 S STDT=$P($G(INPUT),U),ENDDT=$P($G(INPUT),U,2)
123 S STA=$P($G(INPUT),U,3),STATUS=$P($G(INPUT),U,4)
124 I (STDT="")!(ENDDT="")!(STA="")!(STATUS="") D Q
125 .S RESULTS(0)="Input parameters missing, cannot run report." Q
126 S STATUS=$S(STATUS="O":0,STATUS="C":1,1:"")
127 S (SDATE,EDATE)=""
128 S X=STDT D ^%DT S SDATE=Y
129 S X=ENDDT D ^%DT S EDATE=Y
130 S SDATE=(SDATE-1)_".9999",EDATE=EDATE_".9999"
131 S SSN="" I CALL="Employee" S SSN=$$GET1^DIQ(200,DUZ,9)
132 S LP="",IEN=""
133 F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE) D
134 .F S IEN=$O(^OOPS(2260,"AD",LP,IEN)) Q:IEN'>0 D
135 ..S CS=$$GET1^DIQ(2260,IEN,51,"I")
136 ..I $G(CS)>1 Q ; exclude deleted, amended cases
137 ..I (STATUS'=""),(CS'=STATUS) Q ; if 'All cases, status must match
138 ..S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9)
139 ..I $G(STA)'="A",STATION'=STA Q
140 ..I (CALL="Supervisor"),($$GET1^DIQ(2260,IEN,53,"I")'=DUZ&($$GET1^DIQ(2260,IEN,53.1,"I")'=DUZ)) Q
141 ..S (ARR,CASE,PERSON,SSN1,DOI,INC,CAT,WCP,EMP,SUP,SUPER,SAF,SP)=""
142 ..S CASE=$$GET1^DIQ(2260,IEN,.01),SUPER=$$GET1^DIQ(2260,IEN,53)
143 ..S (PERSON,SSN1)=""
144 ..I CALL'="Union" S PERSON=$E($$GET1^DIQ(2260,IEN,1),1,30),SSN1=$$GET1^DIQ(2260,IEN,5)
145 ..S INC=$$GET1^DIQ(2260,IEN,52,"I"),DOI=$$GET1^DIQ(2260,IEN,4)
146 ..S CAT=$$GET1^DIQ(2260,IEN,2,"I")
147 ..; patch 4 llh - get case status title
148 ..S CS=$S(CS=0:"Open",CS=1:"Closed",1:"") I SSN1="" S SSN1=" "
149 ..S ARR=" ",^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
150 ..S ARR="Case Number Name SSN Case Status Date/Time of Incident"
151 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
152 ..S PERSON=PERSON_" ",PERSON=$E(PERSON,1,37)
153 ..I $L(CASE)=10 S CASE=CASE_" "
154 ..;patch 4 llh - pad case status title if needed for alignment
155 ..I $L(CS)=4 S CS=CS_" "
156 ..S ARR=CASE_" "_PERSON_SSN1_" "_CS_" "_DOI
157 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
158 ..I CALL="Employee" Q:SSN'=SSN1
159 ..S ISEMP=$$ISEMP^OOPSUTL4(IEN)
160 ..I 'ISEMP S ISEMP="N/A("_$E($$GET1^DIQ(2260,IEN,2,"E"),1,10)_")"
161 ..S SIGN="",SIGSTR="^^^^^^"
162 ..S SIGN=$P($$EDSTA^OOPSUTL1(IEN,"E"),U,INC)
163 ..S $P(SIGSTR,U,INC)=$S('SIGN:"Un-Signed",SIGN:"Signed",1:"")
164 ..I 'ISEMP S $P(SIGSTR,U,INC)=ISEMP
165 ..S (SIGN,PCE,SUPSTR)=""
166 ..S SIGN=$$EDSTA^OOPSUTL1(IEN,"S"),PCE=INC+2
167 ..I ISEMP S $P(SIGSTR,U,PCE)=$S('$P(SIGN,U,INC):"Un-Signed",$P(SIGN,U,INC):"Signed",1:"")
168 ..S $P(SIGSTR,U,5)=$S($P(SIGN,U,3):"Signed",1:"Un-Signed")
169 ..S SIGN="",SIGN=$$EDSTA^OOPSUTL1(IEN,"O")
170 ..S $P(SIGSTR,U,6)=$S($P(SIGN,U):"Signed",1:"Un-Signed")
171 ..S SIGN="",SIGN=$$GET1^DIQ(2260,IEN,68)
172 ..S $P(SIGSTR,U,7)=$S((($P(SIGN,U)="")&ISEMP):"Un-Signed",($P(SIGN,U)'=""):"Signed",1:"")
173 ..F I=1:1:7 I $P(SIGSTR,U,I)="Signed" D
174 ...I I=1 S $P(SIGSTR,U,1)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,121,"I")),"2DZ")
175 ...I I=2 S $P(SIGSTR,U,2)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,223,"I")),"2DZ")
176 ...I I=3 S $P(SIGSTR,U,3)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,171,"I")),"2DZ")_" "
177 ...I I=4 S $P(SIGSTR,U,4)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,267,"I")),"2DZ")_" "
178 ...I I=5 S $P(SIGSTR,U,5)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,46,"I")),"2DZ")
179 ...I I=6 S $P(SIGSTR,U,6)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,50,"I")),"2DZ")
180 ...I I=7 S $P(SIGSTR,U,7)=$$FMTE^XLFDT(($$GET1^DIQ(2260,IEN,69,"I")),"2DZ")
181 ..S ARR=S48_" "_"CA1"_S12_"CA2"_S12_"2162"_S12_"WCP"
182 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
183 ..S ARR=S48_" "_"---"_S12_"---"_S12_"----"_S12_"---"
184 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
185 ..S EMPSTR=S20_S20_" Employee: "
186 ..I INC=1 S ARR=EMPSTR_$P(SIGSTR,U,1)
187 ..I INC=2 S ARR=EMPSTR_S12_" "_$P(SIGSTR,U,2)
188 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
189 ..; patch 11 - add supervisors name
190 ..I $G(SUPER)'="" S SUPSTR=SUPER_", Supervisor: " F I=1:1:58 Q:$L(SUPSTR)>57 S SUPSTR=" "_SUPSTR
191 ..E S SUPSTR=S20_S20_" Supervisor: "
192 ..I 'ISEMP S SUPSTR=SUPSTR_" "
193 ..I INC=1 D
194 ...I $P(SIGSTR,U,3)="Signed" S ARR=SUPSTR_$P(SIGSTR,U,3)_S6_S12_$P(SIGSTR,U,5)
195 ...E S ARR=SUPSTR_$P(SIGSTR,U,3)_S20_" "_$P(SIGSTR,U,5)
196 ..I INC=2 D
197 ...I $P(SIGSTR,U,4)="Signed" S ARR=SUPSTR_S12_" "_$P(SIGSTR,U,4)_" "_$P(SIGSTR,U,5)
198 ...E S ARR=SUPSTR_S12_" "_$P(SIGSTR,U,4)_S6_$P(SIGSTR,U,5)
199 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
200 ..S ARR=S20_S12_" Safety Officer:"_S20_S12_" "_$P(SIGSTR,U,6)
201 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
202 ..S ARR=S20_S12_" Workers' Comp:"_S48_" "_$P(SIGSTR,U,7)
203 ..S ^TMP($J,"ACCID",CN)=ARR,CN=CN+1,ARR=""
204 S RESULTS=$NA(^TMP($J,"ACCID"))
205 Q
Note: See TracBrowser for help on using the repository browser.