source: FOIAVistA/trunk/r/ASISTS-OOPS/OOPSGUIF.m@ 1458

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1OOPSGUIF ;WIOFO/LLH-RPC routine for OSHA Log ;11/5/01
2 ;;2.0;ASISTS;**6,7,11**;Jun 03, 2002
3 ;
4OSHA(RESULTS,INPUT,CALL) ; get the data
5 ; Input: INPUT - contains 4 values, the START AND END DATE,
6 ; STATION, and INCLUDE NAME ON REPORT. The Date of
7 ; Occ (fld #4) is used to in/exclude claims from the
8 ; report. If Include name = Y, then names are
9 ; printed, else they will not,and if Station='ALL'
10 ; then all claims are included, if not 'All', then
11 ; only 1 station is included.
12 ; CALL - Contains the calling menu. If caller = "U"nion
13 ; name is excluded from printing.
14 ; Output: RESULTS - the results array passes data back to the client.
15 N CN,DA,IEN,INCNA,OCC,OOPS,PERSON,SDATE,STDT,STA,ENDDT,EDATE,X,Y
16 N GONE,LOST,DOI,CAX,FILL,TYPE
17 K ^TMP($J,"OSHA")
18 S CN=1,RESULTS(0)="Processing..."
19 S STDT=$P($G(INPUT),U),ENDDT=$P($G(INPUT),U,2)
20 S STA=$P($G(INPUT),U,3)
21 S INCNA=$P($G(INPUT),U,4)
22 I (STDT="")!(ENDDT="")!(STA="")!(INCNA="") D Q
23 . S RESULTS(0)="Input parameters missing, cannot run report." Q
24 S (SDATE,EDATE)=""
25 S X=STDT D ^%DT S SDATE=Y
26 S X=ENDDT D ^%DT S EDATE=Y
27 ; SDATE made last time in day prior so start date correct
28 S SDATE=(SDATE-1)_".9999",EDATE=EDATE_".9999"
29 S LP="",IEN=""
30 F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE) D
31 . F S IEN=$O(^OOPS(2260,"AD",LP,IEN)) Q:IEN'>0 D
32 .. I $$GET1^DIQ(2260,IEN,88,"I")'="Y" Q
33 .. I $$GET1^DIQ(2260,IEN,51,"I")>1 Q
34 .. S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9)
35 .. I $G(STA)'="A",(STATION'=STA) Q
36 .. K OOPS,ARR S DIC="^OOPS(2260,"
37 .. S DR=".01;1;3;4;15;30;33;52;63;86;89"
38 .. S DA=IEN,DIQ="OOPS",DIQ(0)="IE" D EN^DIQ1
39 .. S CAX=OOPS(2260,IEN,52,"I")
40 .. S DOI=OOPS(2260,IEN,4,"I"),DOI=$P($$FMTE^XLFDT(DOI,2),"@")
41 .. ; PER A. BIERENBAUM, GET OCC DESC 5/13/02
42 .. S OCC=$$OCCDESC(IEN)
43 .. ; S OCC=OOPS(2260,IEN,63,"E")_$E(OOPS(2260,IEN,15,"E"),1,4)
44 .. S GONE=OOPS(2260,IEN,89,"I"),GONE=$S(GONE="Y":"X",1:"")
45 .. S LOST=OOPS(2260,IEN,33,"I")
46 .. S LOST=$S(LOST="Y":"X^",LOST="N":"^X",1:"^X")
47 .. S TYPE=OOPS(2260,IEN,3,"I")
48 .. I TYPE>10&(TYPE<15) S PERSON="Privacy Case"
49 .. S PERSON=OOPS(2260,IEN,1,"E") I CALL="Union"!(INCNA="N") S PERSON=""
50 .. S ARR=OOPS(2260,IEN,.01,"E")_U_DOI_U
51 .. S ARR=ARR_PERSON_U_OCC_U_$E(OOPS(2260,IEN,86,"E"),1,35)_U
52 .. S ARR=ARR_OOPS(2260,IEN,3,"E")_U_OOPS(2260,IEN,30,"E")_U
53 .. S FILL="" I CAX=2 S FILL="^^^"
54 .. S ARR=ARR_FILL_GONE_U_LOST
55 .. S ^TMP($J,"OSHA",CN)=ARR,CN=CN+1
56 S RESULTS=$NA(^TMP($J,"OSHA"))
57 Q
58NSTICK(RESULTS,INPUT,CALL) ; NeedleStick Log get data logic
59 ; Input: INPUT - contains 4 values, the START DATE, END DATE,
60 ; STATION, and INCLUDE NAME ON REPORT. The Date of
61 ; Occurrence (field #4) will be used to include/
62 ; exclude claims from the report. If the Include
63 ; name is = Y then the names will be printed, if no
64 ; they will not, and if the Station = 'ALL' then any
65 ; claim will be include, if not 'All', but the
66 ; station number then only 1 station is included.
67 ; CALL - Contains the calling menu. This will be used
68 ; to exclude the name from printing if the caller
69 ; is 'U'nion.
70 ; Output: RESULTS - the results array passes the data back to the
71 ; client.
72 N CN,DA,IEN,INCNA,OCC,PERSON,SDATE,STDT,STA,ENDDT,EDATE,X,Y
73 N LOST,DOI,OOPS,TYPE
74 K ^TMP($J,"NS")
75 S CN=1,RESULTS(0)="Processing..."
76 S STDT=$P($G(INPUT),U),ENDDT=$P($G(INPUT),U,2)
77 S STA=$P($G(INPUT),U,3)
78 S INCNA=$P($G(INPUT),U,4)
79 I (STDT="")!(ENDDT="")!(STA="")!(INCNA="") D Q
80 . S RESULTS(0)="Input parameters missing, cannot run report." Q
81 S (SDATE,EDATE)=""
82 S X=STDT D ^%DT S SDATE=Y
83 S X=ENDDT D ^%DT S EDATE=Y
84 ; SDATE made last time in day prior so start date correct
85 S SDATE=(SDATE-1)_".9999",EDATE=EDATE_".9999"
86 S LP="",IEN=""
87 F LP=SDATE:0 S LP=$O(^OOPS(2260,"AD",LP)) Q:(LP'>0)!(LP>EDATE) D
88 . F S IEN=$O(^OOPS(2260,"AD",LP,IEN)) Q:IEN'>0 D
89 .. ; exclude deleted, replaced by amendment cases
90 .. I $$GET1^DIQ(2260,IEN,51,"I")>1 Q
91 .. S STATION=$P(^OOPS(2260,IEN,"2162A"),U,9)
92 .. I $G(STA)'="A",(STATION'=STA) Q
93 .. ; if Type Incident not = Hollow Bore Needlestick, Sharps Exposure,
94 .. ; Exposure to Body Fluids/Splash, Suture Needlestick don't include
95 .. S TYPE=$$GET1^DIQ(2260,IEN,3,"I")
96 .. I TYPE<11!(TYPE>14) Q
97 .. ; now get the data and put in array.
98 .. K OOPS,ARR S DIC="^OOPS(2260,"
99 .. S DR=".01;1;3;4;15;14;29;30;33;37;38;51;52;82;86;108"
100 .. S DA=IEN,DIQ="OOPS",DIQ(0)="IE" D EN^DIQ1
101 .. S DOI=OOPS(2260,IEN,4,"E")
102 .. ; PER A. BIERENBAUM, USE OCC DESC 5/13/02
103 .. S OCC=$$OCCDESC(IEN)
104 .. ; S OCC=$E(OOPS(2260,IEN,15,"E"),1,4)
105 .. ; patch 7 remove lost time
106 .. ; S LOST=OOPS(2260,IEN,33,"E")
107 .. S INJILL=OOPS(2260,IEN,52,"I")
108 .. S INJILL=$S(INJILL=1:"Injury",INJILL=2:"Illness",1:"")
109 .. ; patch 7 - only print privacy case in name field - all cases
110 .. S PERSON="Privacy Case"
111 .. ; S PERSON=OOPS(2260,IEN,1,"E")
112 .. I CALL="Union"!(INCNA="N") S PERSON=""
113 .. S ARR=IEN_U_OOPS(2260,IEN,.01,"E")_U_DOI_U_PERSON_U_INJILL_U
114 .. S ARR=ARR_OOPS(2260,IEN,51,"E")_U_OCC_U_$E(OOPS(2260,DA,14,"E"),1,4)
115 .. S ARR=ARR_U_OOPS(2260,IEN,86,"E")_U
116 .. S ARR=ARR_OOPS(2260,IEN,3,"E")_U_OOPS(2260,IEN,108,"E")
117 .. S ARR=ARR_U_OOPS(2260,IEN,30,"E")_U_$E(OOPS(2260,IEN,29,"E"),1,45)_U
118 .. S ARR=ARR_$E(OOPS(2260,IEN,37,"E"),1,50)_U
119 .. S ARR=ARR_$E(OOPS(2260,IEN,38,"E"),1,50)_U_OOPS(2260,IEN,82,"E")
120 .. S ^TMP($J,"NS",CN)=ARR K ARR
121 .. S CN=CN+1
122 S RESULTS=$NA(^TMP($J,"NS"))
123 Q
124OCCDESC(IEN) ;Get Occupation Description
125 ;
126 ; Input: IEN - IEN of the ASISTS Case number to get the Occ Desc
127 ; Output: - will be the Occupation description
128 ;
129 N INC,FLD
130 S INC=$$GET1^DIQ(2260,IEN,52,"I")
131 S FLD=$S(INC=1:111,INC=2:208,1:"")
132 I 'FLD Q ""
133 Q $$GET1^DIQ(2260,IEN,FLD)
134DSPUTE ; Reason for Dispute Report - called from DSPUTE^OOPSGUIR
135 ; code in DSPUTE^OOPSGUIF requires case to be a CA1
136 N BLK36,DIS,DSPCD,F174
137 S F174=$$GET1^DIQ(2260,IEN,174,"I") ; determines lost time or not
138 S F174=$S(F174=3:"LT",1:"NLT")
139 S DIS=$$GET1^DIQ(2260,IEN,165.2,"I"),DSPCD=$$GET1^DIQ(2260,IEN,347)
140 I $G(DIS)="" S DIS="N"
141 I DIS="N" S DSPCD="zCase not disputed, no dispute code expected"
142 I (DIS="Y"),DSPCD="" S DSPCD="zCase disputed, no dispute code entered"
143 ;if data in State the reason in detail question and case controverted
144 ;don't count, otherwise report number of entries in free text field
145 S BLK36=""
146 I DIS="Y",($P($G(^OOPS(2260,IEN,"CA1K",0)),U,3)) D
147 .I $$GET1^DIQ(2260,IEN,165.1,"I")="Y" Q
148 .S BLK36="zBlk 36 also has text entered"
149 S:'$D(ARR(DSPCD,F174)) ARR(DSPCD,F174)=0
150 S ARR(DSPCD,F174)=ARR(DSPCD,F174)+1
151 I BLK36'="" D
152 .S:'$D(ARR(BLK36,F174)) ARR(BLK36,F174)=0
153 .S ARR(BLK36,F174)=ARR(BLK36,F174)+1
154 Q
Note: See TracBrowser for help on using the repository browser.