Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUSUR1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUSUR1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXUSUR1.m
r613 r623 1 ECXUSUR1 ;ALB/TJL-Surgery Extract Unusual Volume Report ; 1/8/08 9:58am 2 ;;3.0;DSS EXTRACTS;**49,71,105,111**;July 1, 2003;Build 4 3 EN ; 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 ; 13 STUFF ;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,2)=ECNT 65 ; 66 ;- Was surgery cancelled/aborted 67 S ECCAN=$P($G(^SRF(ECD0,30)),U) 68 I +ECCAN S ECCAN=$$CANC^ECXUTL4(ECNL,$P(DATA2,U,10)) 69 ; 70 I ECXFLAG D FILE Q 71 N PIECE,FILE 72 S FILE="NO" 73 F PIECE=1,2,3,4,5,6 D 74 . I $P(ECODE0,U,PIECE)>ECTHLD S FILE="YES" 75 . I $P(ECODE0,U,PIECE)<0 S FILE="YES" 76 ; 77 I FILE="YES" D FILE Q:ECXERR 78 Q 79 ; 80 FILE ; Store unusual records for display later 81 N OK,SURPAT,SURNAME,SURSSN,SURDT,VOL 82 S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECD,"."),"1;",.SURPAT) 83 I 'OK Q 84 S SURNAME=SURPAT("NAME") 85 S SURSSN=SURPAT("SSN") 86 S SURDT=$E(ECXDATE,4,5)_"/"_$E(ECXDATE,6,7)_"/"_$E(ECXDATE,2,3) 87 ; 88 ; Observation Patient Indicator (yes/no) 89 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL) 90 ; 91 ; Principal Procedure 92 S ECXPROC=$E($P(DATAOP,U),1,15) 93 ; 94 ; If no encounter number don't file record 95 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC="" 96 ; 97 S VOL=$P(ECODE0,U) 98 I $P(ECODE0,U,2)>VOL S VOL=$P(ECODE0,U,2) 99 I $P(ECODE0,U,3)>VOL S VOL=$P(ECODE0,U,3) 100 S ^TMP($J,-VOL,-ECD0)=SURNAME_U_SURSSN_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC_U_ECCAN 101 S COUNT=COUNT+1 102 I COUNT#100=0 I $$S^ZTLOAD S (ZSTOP,ECXERR)=1 103 Q 104 ; 105 TIME ; given date/time get increment 106 N CON 107 S CON=$P($G(^SRF(ECD0,"CON")),U) 108 D TIMEDIF(A1,A2) 109 I 'CON D 110 .S TIME=$J($TR($J(TIMEDIF,4,0)," "),2,1) 111 .S:TIME>"99.0" TIME="99.0" 112 I CON D 113 .S TIME=$J(($TR($J(TIMEDIF,4,0)," ")/2),2,1) 114 .S:TIME>"99.5" TIME="99.5" 115 ;S:TIME<0 TIME="###" 116 Q 117 ; 118 TIMEDIF(START,FINISH) ; Set values to be compared, in seconds 119 ; 120 S TIMEDIF=$$FMDIFF^XLFDT(START,FINISH,2)/900 121 I (TIMEDIF>0)&(TIMEDIF<.5) S TIMEDIF=.5 122 Q 123 ; 124 EXIT S ECXERR=1 Q 1 ECXUSUR1 ;ALB/TJL-Surgery Extract Unusual Volume Report ; 12/1/04 4:48pm 2 ;;3.0;DSS EXTRACTS;**49,71**;July 1, 2003 3 EN ; 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 ; 13 STUFF ;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 ; 75 FILE ; 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 ; 100 TIME ; 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 ; 113 TIMEDIF(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 ; 119 EXIT S ECXERR=1 Q
Note:
See TracChangeset
for help on using the changeset viewer.
