source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUSUR1.m@ 701

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

revised back to 6/30/08 version

File size: 3.4 KB
Line 
1ECXUSUR1 ;ALB/TJL-Surgery Extract Unusual Volume Report ; 12/1/04 4:48pm
2 ;;3.0;DSS EXTRACTS;**49,71**;July 1, 2003
3EN ;
4 N ECHEAD,COUNT,TIMEDIF,ECXPROC
5 S ECHEAD="SUR"
6 S (COUNT,QFLG)=0,ECED=ECED+.3,ECD=ECSD1
7 F S ECD=$O(^SRF("AC",ECD)) Q:('ECD)!(ECD>ECED)!(QFLG) D
8 .S ECD0=0
9 .F S ECD0=$O(^SRF("AC",ECD,ECD0)) Q:'ECD0 D
10 ..I $D(^SRF(ECD0,0)) S ECXDFN=+$P(^(0),U,1) D STUFF Q:QFLG
11 Q
12 ;
13STUFF ;gather data
14 N J,DATA1,DATA2,DATAOP,ECXNONL,ECXSTOP
15 S ECXDATE=ECD,ECXERR=0,ECXQ=""
16 Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;")
17 S EC0=^SRF(ECD0,0)
18 S DATA1=$S($D(^SRF(ECD0,.1)):^(.1),1:"")
19 S DATA2=$S($D(^SRF(ECD0,.2)):^(.2),1:"")
20 S DATAOP=$S($D(^SRF(ECD0,"OP")):^("OP"),1:"")
21 S DATAPA=$S($D(^SRF(ECD0,1.1)):^(1.1),1:"")
22 S ECNO=$G(^SRF(ECD0,"NON"))
23 ;get data
24 S ECSS=$P($G(^SRO(137.45,+$P(EC0,U,4),0)),U,2)
25 S ECSS=$$RJ^XLFSTR($P($G(^DIC(45.3,+ECSS,0)),U),3,0)
26 S:ECSS="000" ECSS="999"
27 ;look for non-OR
28 S (ECNT,ECNL,ECXNONL,ECXSTOP)=""
29 I $P(ECNO,U)="Y" D
30 .S A1=$P(ECNO,U,5)
31 .S A2=$P(ECNO,U,4)
32 .S TIME="##"
33 .D:(A1&A2) TIME S ECNT=TIME
34 .S ECXNONL=+$P(ECNO,U,2)
35 .S ECNL=$P($G(^ECX(728.44,ECXNONL,0)),U,9)
36 .I ECNL="" S ECNL="UNKNOWN"
37 .;
38 .; Get DSS Stop Code to use in encounter number
39 .S ECXSTOP=$P($G(^ECX(728.44,ECXNONL,0)),U,4)
40 ;
41 ;retrieving anesthesia times first, then operation and patient
42 ;times, then storing in following order:
43 ;ecode0="recovery room time^pt hold area time^or clean time^patient
44 ;time^operation time^anesthesia time
45 S ECODE0=""
46 F J="1,4","2,3","10,12","13,14","15,10" D
47 .S A2=$P(DATA2,U,$P(J,","))
48 .S A1=$P(DATA2,U,$P(J,",",2))
49 .S TIME="##"
50 .I (A1&A2) D TIMEDIF(A1,A2) D
51 ..I +J'=2 D TIME
52 ..I +J=2 D ;-Operation Time
53 ...S TIME=$TR($J(TIMEDIF,4,0)," ")
54 ...;I TIME<0 S TIME="###"
55 .S ECODE0=TIME_U_ECODE0 K TIME
56 ;
57 ;retrieve recovery room (PACU) time
58 S A2=$P($G(DATAPA),U,7)
59 S A1=$P($G(DATAPA),U,8)
60 S TIME="##"
61 I (A1&A2) D TIME
62 S ECODE0=TIME_U_ECODE0 K TIME
63 ;
64 I ECNL]"" S $P(ECODE0,U,5)=ECNT
65 ;
66 I ECXFLAG D FILE Q
67 N PIECE,FILE
68 S FILE="NO"
69 F PIECE=1,2,3,4,5,6 D
70 . I $P(ECODE0,U,PIECE)>ECTHLD S FILE="YES"
71 . I $P(ECODE0,U,PIECE)<0 S FILE="YES"
72 I FILE="YES" D FILE Q:ECXERR
73 Q
74 ;
75FILE ; Store unusual records for display later
76 N OK,SURPAT,SURNAME,SURSSN,SURDT,VOL
77 S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECD,"."),"1;",.SURPAT)
78 I 'OK Q
79 S SURNAME=SURPAT("NAME")
80 S SURSSN=SURPAT("SSN")
81 S SURDT=$E(ECXDATE,4,5)_"/"_$E(ECXDATE,6,7)_"/"_$E(ECXDATE,2,3)
82 ;
83 ; Observation Patient Indicator (yes/no)
84 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL)
85 ;
86 ; Principal Procedure
87 S ECXPROC=$E($P(DATAOP,U),1,15)
88 ;
89 ; If no encounter number don't file record
90 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC=""
91 ;
92 S VOL=$P(ECODE0,U,4)
93 I $P(ECODE0,U,5)>VOL S VOL=$P(ECODE0,U,5)
94 I $P(ECODE0,U,6)>VOL S VOL=$P(ECODE0,U,6)
95 S ^TMP($J,-VOL,-ECD0)=SURNAME_U_SURSSN_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC
96 S COUNT=COUNT+1
97 I COUNT#100=0 I $$S^ZTLOAD S (ZSTOP,ECXERR)=1
98 Q
99 ;
100TIME ; given date/time get increment
101 N CON
102 S CON=$P($G(^SRF(ECD0,"CON")),U)
103 D TIMEDIF(A1,A2)
104 I 'CON D
105 .S TIME=$J($TR($J(TIMEDIF,4,0)," "),2,1)
106 .S:TIME>"99.0" TIME="99.0"
107 I CON D
108 .S TIME=$J(($TR($J(TIMEDIF,4,0)," ")/2),2,1)
109 .S:TIME>"99.5" TIME="99.5"
110 ;S:TIME<0 TIME="###"
111 Q
112 ;
113TIMEDIF(START,FINISH) ; Set values to be compared, in seconds
114 ;
115 S TIMEDIF=$$FMDIFF^XLFDT(START,FINISH,2)/900
116 I (TIMEDIF>0)&(TIMEDIF<.5) S TIMEDIF=.5
117 Q
118 ;
119EXIT S ECXERR=1 Q
Note: See TracBrowser for help on using the repository browser.