ECXUSUR1 ;ALB/TJL-Surgery Pre-Extract Unusual Volume Report ;6/15/17 15:44
;;3.0;DSS EXTRACTS;**49,71,105,111,128,148,161,166,184,185,187**;Dec 22, 1997;Build 163
;
; Reference to ^SRF in ICR #103
; Reference to ^SRO(137.45 in ICR #1855
; Reference to ^DG(40.8,"AD" in ICR #2817
; Reference to $$FMDIFF^XLFDT in ICR #10103
; Reference to ^TMP supported by SACC 2.3.2.5.1
; Reference to ^DIC(45.3 in ICR #218
;
EN ;
N ECHEAD,COUNT,TIMEDIF,ECXPROC
S ECHEAD="SUR"
S (COUNT,QFLG)=0,ECED=ECED+.3,ECD=ECSD1
F S ECD=$O(^SRF("AC",ECD)) Q:('ECD)!(ECD>ECED)!(QFLG) D
.S ECD0=0
.F S ECD0=$O(^SRF("AC",ECD,ECD0)) Q:'ECD0 D
..I $D(^SRF(ECD0,0)) S ECXDFN=+$P(^(0),U,1) D STUFF Q:QFLG
Q
;
STUFF ;gather data
N J,DATA1,DATA2,DATAOP,ECXNONL,ECXSTOP,DATAPA ;161
N ECXPDIV,ECDIV ;184
N ECNTIME,ECSA,ECSAPC,ECXPA,ECXPAPC,DATA3 ;187
N ECXPDVNM,PRODVSTR,DIQ,DR,DA,DIC,INST,ECXDIV,ECDIVIEN ;185
S ECXPDIV="" ;184
S ECXDATE=ECD,ECXERR=0,ECXQ=""
Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;")
S EC0=^SRF(ECD0,0)
S DATA1=$S($D(^SRF(ECD0,.1)):^(.1),1:"")
S DATA2=$S($D(^SRF(ECD0,.2)):^(.2),1:"")
S DATAOP=$S($D(^SRF(ECD0,"OP")):^("OP"),1:"")
S DATAPA=$S($D(^SRF(ECD0,1.1)):^(1.1),1:"")
S DATA3=$S($D(^SRF(ECD0,.3)):^(.3),1:"") ;187
S ECSA=$P(DATA3,U,4) ;187
S ECXPA=$P(DATA3,U) ;187
S ECSAPC=$$PRVCLASS^ECXUTL(ECSA,ECXDATE) ;187
S ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE) ;187
S ECNO=$G(^SRF(ECD0,"NON"))
S ECDIV=$S($D(^SRF(ECD0,8)):^(8),1:"") ;184
;S ECXPDIV=$$RADDIV^ECXDEPT(ECDIV) ;184 - Production Division; 185
S ECDIVIEN=$O(^DG(40.8,"AD",ECDIV,0)) ;185
S DIC="^DG(40.8,",DR=".01;1",DIQ(0)="I",DIQ="ECXDIV",DA=ECDIVIEN K ECXDIV D EN^DIQ1 ;185 - Get Division Number and Name
S ECXPDIV=ECXDIV(40.8,ECDIVIEN,1,"I") ;185
S ECXPDVNM=ECXDIV(40.8,ECDIVIEN,.01,"I") ;185
S PRODVSTR=ECXPDIV_"~"_ECXPDVNM ;185
;get data
S ECSS=$P($G(^SRO(137.45,+$P(EC0,U,4),0)),U,2)
S ECSS=$$RJ^XLFSTR($P($G(^DIC(45.3,+ECSS,0)),U),3,0)
S:ECSS="000" ECSS="999"
;look for non-OR
S (ECNT,ECNL,ECXNONL,ECXSTOP)=""
I $P(ECNO,U)="Y" D
.S A1=$P(ECNO,U,5)
.S A2=$P(ECNO,U,4)
.S (TIME,ECNT)=$$CHKTM(A2,A1) ;161
.I A1&(A2)&(TIME="") D TIME ;161
.S ECXNONL=+$P(ECNO,U,2)
.S ECNL=$P($G(^ECX(728.44,ECXNONL,0)),U,9)
.I ECNL="" S ECNL="UNKNOWN"
.;
.; Get DSS Stop Code to use in encounter number
.S ECXSTOP=$P($G(^ECX(728.44,ECXNONL,0)),U,4)
;
;retrieving anesthesia times first, then operation and patient
;times, then storing in following order:
;ecode0="recovery room time^pt hold area time^or clean time^patient
;time^operation time^anesthesia time
S ECODE0=""
S ECNTIME="" ;187
F J="2,3","10,12","13,14","15,10","1,4" D ;187 Anesthesia time is calculated last
.S A2=$P(DATA2,U,$P(J,","))
.S A1=$P(DATA2,U,$P(J,",",2))
.S TIME=$$CHKTM(A2,A1) ;161
.I +J=1 D ANTIME^ECXSURG S:TIME="" TIME="NO TIMES" ;187
.I A1&(A2)&(TIME="") D TIMEDIF(A1,A2) D ;161
..I +J'=2 D TIME
..I +J=10 S ECNTIME=TIME ;187
..I +J=2 D ;-Operation Time
...S TIME=$TR($J(TIMEDIF,4,0)," ")
...;I TIME<0 S TIME="###"
.S ECODE0=TIME_U_ECODE0 K TIME
S ECODE0=$P(ECODE0,U,2,5)_U_$P(ECODE0,U)_U ;187
;retrieve recovery room (PACU) time
S A2=$P($G(DATAPA),U,7)
S A1=$P($G(DATAPA),U,8)
S TIME=$$CHKTM(A2,A1) ;161
I A1&(A2)&(TIME="") D TIME ;161
S ECODE0=TIME_U_ECODE0 K TIME
;Place the NON-OR PROCEDURE into the operation time for the report ECX*128
I ECNL]"" S $P(ECODE0,U,5)=ECNT
;
;- Was surgery cancelled/aborted
S ECCAN=$P($G(^SRF(ECD0,30)),U)
I +ECCAN S ECCAN=$$CANC^ECXUTL4(ECNL,$P(DATA2,U,10))
;
I ECXFLAG D FILE Q
N PIECE,FILE
S FILE="NO"
F PIECE=1,2,3,4,5,6 D
. I $P(ECODE0,U,PIECE)>ECTHLD S FILE="YES"
. I $P(ECODE0,U,PIECE)<0 S FILE="YES"
;
I FILE="YES" D FILE Q:ECXERR
Q
;
FILE ; Store unusual records for display later
N OK,SURPAT,SURNAME,SURSSN,SURDT,VOL
S OK=$$PAT^ECXUTL3(ECXDFN,$P(ECD,"."),"1;",.SURPAT)
I 'OK Q
S SURNAME=SURPAT("NAME")
S SURSSN=SURPAT("SSN")
S SURDT=$E(ECXDATE,4,5)_"/"_$E(ECXDATE,6,7)_"/"_$E(ECXDATE,2,3)
;
; Observation Patient Indicator (yes/no)
S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL)
;
; Principal Procedure
S ECXPROC=$S('$G(ECXPORT):$E($P(DATAOP,U),1,15),1:$P(DATAOP,U)) ;161 Report full procedure if exporting
;
; If no encounter number don't file record
S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC=""
;
S VOL=$P(ECODE0,U)
I $P(ECODE0,U,2)>VOL S VOL=$P(ECODE0,U,2)
I $P(ECODE0,U,3)>VOL S VOL=$P(ECODE0,U,3)
;S ^TMP($J,-VOL,-ECD0)=SURNAME_U_SURSSN_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC_U_ECCAN_U_ECXPDIV ;184 Added ECXPDIV
S ^TMP($J,PRODVSTR,-VOL,-ECD0)=SURNAME_U_$S(ECXPORT:SURSSN,1:$E(SURSSN,6,9))_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC_U_ECCAN ;184 Added ECXPDIV,185 Replaced ECXPDIV with PRODVSTR
S COUNT=COUNT+1
I COUNT#100=0 I $$S^ZTLOAD S (ZTSTOP,ECXERR)=1 ;166 Changed ZSTOP to ZTSTOP
Q
;
TIME ; given date/time get increment
N CON
S CON=$P($G(^SRF(ECD0,"CON")),U)
D TIMEDIF(A1,A2)
I 'CON D
.S TIME=$J($TR($J(TIMEDIF,4,0)," "),2,1)
.S:TIME>"99.0" TIME="99.0"
I CON D
.S TIME=$J(($TR($J(TIMEDIF,4,0)," ")/2),2,1)
.S:TIME>"99.5" TIME="99.5"
;S:TIME<0 TIME="###"
Q
;
TIMEDIF(START,FINISH) ; Set values to be compared, in seconds
;
S TIMEDIF=$$FMDIFF^XLFDT(START,FINISH,2)/900
I (TIMEDIF>0)&(TIMEDIF<.5) S TIMEDIF=.5
Q
;
CHKTM(ST,END) ;161 Identify any incorrect or missing times
Q $S('ST&('END):"NO TIMES",'ST:"NO BEG TM",'END:"NO END TM",ST>END:"CHECK TM",1:"")
;
EXIT S ECXERR=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXUSUR1 5610 printed Dec 13, 2024@01:54:21 Page 2
ECXUSUR1 ;ALB/TJL-Surgery Pre-Extract Unusual Volume Report ;6/15/17 15:44
+1 ;;3.0;DSS EXTRACTS;**49,71,105,111,128,148,161,166,184,185,187**;Dec 22, 1997;Build 163
+2 ;
+3 ; Reference to ^SRF in ICR #103
+4 ; Reference to ^SRO(137.45 in ICR #1855
+5 ; Reference to ^DG(40.8,"AD" in ICR #2817
+6 ; Reference to $$FMDIFF^XLFDT in ICR #10103
+7 ; Reference to ^TMP supported by SACC 2.3.2.5.1
+8 ; Reference to ^DIC(45.3 in ICR #218
+9 ;
EN ;
+1 NEW ECHEAD,COUNT,TIMEDIF,ECXPROC
+2 SET ECHEAD="SUR"
+3 SET (COUNT,QFLG)=0
SET ECED=ECED+.3
SET ECD=ECSD1
+4 FOR
SET ECD=$ORDER(^SRF("AC",ECD))
if ('ECD)!(ECD>ECED)!(QFLG)
QUIT
Begin DoDot:1
+5 SET ECD0=0
+6 FOR
SET ECD0=$ORDER(^SRF("AC",ECD,ECD0))
if 'ECD0
QUIT
Begin DoDot:2
+7 IF $DATA(^SRF(ECD0,0))
SET ECXDFN=+$PIECE(^(0),U,1)
DO STUFF
if QFLG
QUIT
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
STUFF ;gather data
+1 ;161
NEW J,DATA1,DATA2,DATAOP,ECXNONL,ECXSTOP,DATAPA
+2 ;184
NEW ECXPDIV,ECDIV
+3 ;187
NEW ECNTIME,ECSA,ECSAPC,ECXPA,ECXPAPC,DATA3
+4 ;185
NEW ECXPDVNM,PRODVSTR,DIQ,DR,DA,DIC,INST,ECXDIV,ECDIVIEN
+5 ;184
SET ECXPDIV=""
+6 SET ECXDATE=ECD
SET ECXERR=0
SET ECXQ=""
+7 if '$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;")
QUIT
+8 SET EC0=^SRF(ECD0,0)
+9 SET DATA1=$SELECT($DATA(^SRF(ECD0,.1)):^(.1),1:"")
+10 SET DATA2=$SELECT($DATA(^SRF(ECD0,.2)):^(.2),1:"")
+11 SET DATAOP=$SELECT($DATA(^SRF(ECD0,"OP")):^("OP"),1:"")
+12 SET DATAPA=$SELECT($DATA(^SRF(ECD0,1.1)):^(1.1),1:"")
+13 ;187
SET DATA3=$SELECT($DATA(^SRF(ECD0,.3)):^(.3),1:"")
+14 ;187
SET ECSA=$PIECE(DATA3,U,4)
+15 ;187
SET ECXPA=$PIECE(DATA3,U)
+16 ;187
SET ECSAPC=$$PRVCLASS^ECXUTL(ECSA,ECXDATE)
+17 ;187
SET ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE)
+18 SET ECNO=$GET(^SRF(ECD0,"NON"))
+19 ;184
SET ECDIV=$SELECT($DATA(^SRF(ECD0,8)):^(8),1:"")
+20 ;S ECXPDIV=$$RADDIV^ECXDEPT(ECDIV) ;184 - Production Division; 185
+21 ;185
SET ECDIVIEN=$ORDER(^DG(40.8,"AD",ECDIV,0))
+22 ;185 - Get Division Number and Name
SET DIC="^DG(40.8,"
SET DR=".01;1"
SET DIQ(0)="I"
SET DIQ="ECXDIV"
SET DA=ECDIVIEN
KILL ECXDIV
DO EN^DIQ1
+23 ;185
SET ECXPDIV=ECXDIV(40.8,ECDIVIEN,1,"I")
+24 ;185
SET ECXPDVNM=ECXDIV(40.8,ECDIVIEN,.01,"I")
+25 ;185
SET PRODVSTR=ECXPDIV_"~"_ECXPDVNM
+26 ;get data
+27 SET ECSS=$PIECE($GET(^SRO(137.45,+$PIECE(EC0,U,4),0)),U,2)
+28 SET ECSS=$$RJ^XLFSTR($PIECE($GET(^DIC(45.3,+ECSS,0)),U),3,0)
+29 if ECSS="000"
SET ECSS="999"
+30 ;look for non-OR
+31 SET (ECNT,ECNL,ECXNONL,ECXSTOP)=""
+32 IF $PIECE(ECNO,U)="Y"
Begin DoDot:1
+33 SET A1=$PIECE(ECNO,U,5)
+34 SET A2=$PIECE(ECNO,U,4)
+35 ;161
SET (TIME,ECNT)=$$CHKTM(A2,A1)
+36 ;161
IF A1&(A2)&(TIME="")
DO TIME
+37 SET ECXNONL=+$PIECE(ECNO,U,2)
+38 SET ECNL=$PIECE($GET(^ECX(728.44,ECXNONL,0)),U,9)
+39 IF ECNL=""
SET ECNL="UNKNOWN"
+40 ;
+41 ; Get DSS Stop Code to use in encounter number
+42 SET ECXSTOP=$PIECE($GET(^ECX(728.44,ECXNONL,0)),U,4)
End DoDot:1
+43 ;
+44 ;retrieving anesthesia times first, then operation and patient
+45 ;times, then storing in following order:
+46 ;ecode0="recovery room time^pt hold area time^or clean time^patient
+47 ;time^operation time^anesthesia time
+48 SET ECODE0=""
+49 ;187
SET ECNTIME=""
+50 ;187 Anesthesia time is calculated last
FOR J="2,3","10,12","13,14","15,10","1,4"
Begin DoDot:1
+51 SET A2=$PIECE(DATA2,U,$PIECE(J,","))
+52 SET A1=$PIECE(DATA2,U,$PIECE(J,",",2))
+53 ;161
SET TIME=$$CHKTM(A2,A1)
+54 ;187
IF +J=1
DO ANTIME^ECXSURG
if TIME=""
SET TIME="NO TIMES"
+55 ;161
IF A1&(A2)&(TIME="")
DO TIMEDIF(A1,A2)
Begin DoDot:2
+56 IF +J'=2
DO TIME
+57 ;187
IF +J=10
SET ECNTIME=TIME
+58 ;-Operation Time
IF +J=2
Begin DoDot:3
+59 SET TIME=$TRANSLATE($JUSTIFY(TIMEDIF,4,0)," ")
+60 ;I TIME<0 S TIME="###"
End DoDot:3
End DoDot:2
+61 SET ECODE0=TIME_U_ECODE0
KILL TIME
End DoDot:1
+62 ;187
SET ECODE0=$PIECE(ECODE0,U,2,5)_U_$PIECE(ECODE0,U)_U
+63 ;retrieve recovery room (PACU) time
+64 SET A2=$PIECE($GET(DATAPA),U,7)
+65 SET A1=$PIECE($GET(DATAPA),U,8)
+66 ;161
SET TIME=$$CHKTM(A2,A1)
+67 ;161
IF A1&(A2)&(TIME="")
DO TIME
+68 SET ECODE0=TIME_U_ECODE0
KILL TIME
+69 ;Place the NON-OR PROCEDURE into the operation time for the report ECX*128
+70 IF ECNL]""
SET $PIECE(ECODE0,U,5)=ECNT
+71 ;
+72 ;- Was surgery cancelled/aborted
+73 SET ECCAN=$PIECE($GET(^SRF(ECD0,30)),U)
+74 IF +ECCAN
SET ECCAN=$$CANC^ECXUTL4(ECNL,$PIECE(DATA2,U,10))
+75 ;
+76 IF ECXFLAG
DO FILE
QUIT
+77 NEW PIECE,FILE
+78 SET FILE="NO"
+79 FOR PIECE=1,2,3,4,5,6
Begin DoDot:1
+80 IF $PIECE(ECODE0,U,PIECE)>ECTHLD
SET FILE="YES"
+81 IF $PIECE(ECODE0,U,PIECE)<0
SET FILE="YES"
End DoDot:1
+82 ;
+83 IF FILE="YES"
DO FILE
if ECXERR
QUIT
+84 QUIT
+85 ;
FILE ; Store unusual records for display later
+1 NEW OK,SURPAT,SURNAME,SURSSN,SURDT,VOL
+2 SET OK=$$PAT^ECXUTL3(ECXDFN,$PIECE(ECD,"."),"1;",.SURPAT)
+3 IF 'OK
QUIT
+4 SET SURNAME=SURPAT("NAME")
+5 SET SURSSN=SURPAT("SSN")
+6 SET SURDT=$EXTRACT(ECXDATE,4,5)_"/"_$EXTRACT(ECXDATE,6,7)_"/"_$EXTRACT(ECXDATE,2,3)
+7 ;
+8 ; Observation Patient Indicator (yes/no)
+9 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL)
+10 ;
+11 ; Principal Procedure
+12 ;161 Report full procedure if exporting
SET ECXPROC=$SELECT('$GET(ECXPORT):$EXTRACT($PIECE(DATAOP,U),1,15),1:$PIECE(DATAOP,U))
+13 ;
+14 ; If no encounter number don't file record
+15 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS)
if ECXENC=""
QUIT
+16 ;
+17 SET VOL=$PIECE(ECODE0,U)
+18 IF $PIECE(ECODE0,U,2)>VOL
SET VOL=$PIECE(ECODE0,U,2)
+19 IF $PIECE(ECODE0,U,3)>VOL
SET VOL=$PIECE(ECODE0,U,3)
+20 ;S ^TMP($J,-VOL,-ECD0)=SURNAME_U_SURSSN_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC_U_ECCAN_U_ECXPDIV ;184 Added ECXPDIV
+21 ;184 Added ECXPDIV,185 Replaced ECXPDIV with PRODVSTR
SET ^TMP($JOB,PRODVSTR,-VOL,-ECD0)=SURNAME_U_$SELECT(ECXPORT:SURSSN,1:$EXTRACT(SURSSN,6,9))_U_SURDT_U_ECD0_U_ECXENC_U_ECODE0_U_ECXPROC_U_ECCAN
+22 SET COUNT=COUNT+1
+23 ;166 Changed ZSTOP to ZTSTOP
IF COUNT#100=0
IF $$S^ZTLOAD
SET (ZTSTOP,ECXERR)=1
+24 QUIT
+25 ;
TIME ; given date/time get increment
+1 NEW CON
+2 SET CON=$PIECE($GET(^SRF(ECD0,"CON")),U)
+3 DO TIMEDIF(A1,A2)
+4 IF 'CON
Begin DoDot:1
+5 SET TIME=$JUSTIFY($TRANSLATE($JUSTIFY(TIMEDIF,4,0)," "),2,1)
+6 if TIME>"99.0"
SET TIME="99.0"
End DoDot:1
+7 IF CON
Begin DoDot:1
+8 SET TIME=$JUSTIFY(($TRANSLATE($JUSTIFY(TIMEDIF,4,0)," ")/2),2,1)
+9 if TIME>"99.5"
SET TIME="99.5"
End DoDot:1
+10 ;S:TIME<0 TIME="###"
+11 QUIT
+12 ;
TIMEDIF(START,FINISH) ; Set values to be compared, in seconds
+1 ;
+2 SET TIMEDIF=$$FMDIFF^XLFDT(START,FINISH,2)/900
+3 IF (TIMEDIF>0)&(TIMEDIF<.5)
SET TIMEDIF=.5
+4 QUIT
+5 ;
CHKTM(ST,END) ;161 Identify any incorrect or missing times
+1 QUIT $SELECT('ST&('END):"NO TIMES",'ST:"NO BEG TM",'END:"NO END TM",ST>END:"CHECK TM",1:"")
+2 ;
EXIT SET ECXERR=1
QUIT
