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**;Dec 22, 1997;Build 134
;
; Reference to ^SRF in ICR #103
; Reference to ^SRO(137.45 in ICR #1855
; Reference to ^DG(40.8,"AD" in ICR #2817
;
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 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 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=""
F J="1,4","2,3","10,12","13,14","15,10" D
.S A2=$P(DATA2,U,$P(J,","))
.S A1=$P(DATA2,U,$P(J,",",2))
.S TIME=$$CHKTM(A2,A1) ;161
.I A1&(A2)&(TIME="") D TIMEDIF(A1,A2) D ;161
..I +J'=2 D TIME
..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
;
;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 5024 printed May 14, 2023@14:20:48 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**;Dec 22, 1997;Build 134
+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 ;
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 ;185
NEW ECXPDVNM,PRODVSTR,DIQ,DR,DA,DIC,INST,ECXDIV,ECDIVIEN
+4 ;184
SET ECXPDIV=""
+5 SET ECXDATE=ECD
SET ECXERR=0
SET ECXQ=""
+6 if '$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;")
QUIT
+7 SET EC0=^SRF(ECD0,0)
+8 SET DATA1=$SELECT($DATA(^SRF(ECD0,.1)):^(.1),1:"")
+9 SET DATA2=$SELECT($DATA(^SRF(ECD0,.2)):^(.2),1:"")
+10 SET DATAOP=$SELECT($DATA(^SRF(ECD0,"OP")):^("OP"),1:"")
+11 SET DATAPA=$SELECT($DATA(^SRF(ECD0,1.1)):^(1.1),1:"")
+12 SET ECNO=$GET(^SRF(ECD0,"NON"))
+13 ;184
SET ECDIV=$SELECT($DATA(^SRF(ECD0,8)):^(8),1:"")
+14 ;S ECXPDIV=$$RADDIV^ECXDEPT(ECDIV) ;184 - Production Division; 185
+15 ;185
SET ECDIVIEN=$ORDER(^DG(40.8,"AD",ECDIV,0))
+16 ;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
+17 ;185
SET ECXPDIV=ECXDIV(40.8,ECDIVIEN,1,"I")
+18 ;185
SET ECXPDVNM=ECXDIV(40.8,ECDIVIEN,.01,"I")
+19 ;185
SET PRODVSTR=ECXPDIV_"~"_ECXPDVNM
+20 ;get data
+21 SET ECSS=$PIECE($GET(^SRO(137.45,+$PIECE(EC0,U,4),0)),U,2)
+22 SET ECSS=$$RJ^XLFSTR($PIECE($GET(^DIC(45.3,+ECSS,0)),U),3,0)
+23 if ECSS="000"
SET ECSS="999"
+24 ;look for non-OR
+25 SET (ECNT,ECNL,ECXNONL,ECXSTOP)=""
+26 IF $PIECE(ECNO,U)="Y"
Begin DoDot:1
+27 SET A1=$PIECE(ECNO,U,5)
+28 SET A2=$PIECE(ECNO,U,4)
+29 ;161
SET (TIME,ECNT)=$$CHKTM(A2,A1)
+30 ;161
IF A1&(A2)&(TIME="")
DO TIME
+31 SET ECXNONL=+$PIECE(ECNO,U,2)
+32 SET ECNL=$PIECE($GET(^ECX(728.44,ECXNONL,0)),U,9)
+33 IF ECNL=""
SET ECNL="UNKNOWN"
+34 ;
+35 ; Get DSS Stop Code to use in encounter number
+36 SET ECXSTOP=$PIECE($GET(^ECX(728.44,ECXNONL,0)),U,4)
End DoDot:1
+37 ;
+38 ;retrieving anesthesia times first, then operation and patient
+39 ;times, then storing in following order:
+40 ;ecode0="recovery room time^pt hold area time^or clean time^patient
+41 ;time^operation time^anesthesia time
+42 SET ECODE0=""
+43 FOR J="1,4","2,3","10,12","13,14","15,10"
Begin DoDot:1
+44 SET A2=$PIECE(DATA2,U,$PIECE(J,","))
+45 SET A1=$PIECE(DATA2,U,$PIECE(J,",",2))
+46 ;161
SET TIME=$$CHKTM(A2,A1)
+47 ;161
IF A1&(A2)&(TIME="")
DO TIMEDIF(A1,A2)
Begin DoDot:2
+48 IF +J'=2
DO TIME
+49 ;-Operation Time
IF +J=2
Begin DoDot:3
+50 SET TIME=$TRANSLATE($JUSTIFY(TIMEDIF,4,0)," ")
+51 ;I TIME<0 S TIME="###"
End DoDot:3
End DoDot:2
+52 SET ECODE0=TIME_U_ECODE0
KILL TIME
End DoDot:1
+53 ;
+54 ;retrieve recovery room (PACU) time
+55 SET A2=$PIECE($GET(DATAPA),U,7)
+56 SET A1=$PIECE($GET(DATAPA),U,8)
+57 ;161
SET TIME=$$CHKTM(A2,A1)
+58 ;161
IF A1&(A2)&(TIME="")
DO TIME
+59 SET ECODE0=TIME_U_ECODE0
KILL TIME
+60 ;Place the NON-OR PROCEDURE into the operation time for the report ECX*128
+61 IF ECNL]""
SET $PIECE(ECODE0,U,5)=ECNT
+62 ;
+63 ;- Was surgery cancelled/aborted
+64 SET ECCAN=$PIECE($GET(^SRF(ECD0,30)),U)
+65 IF +ECCAN
SET ECCAN=$$CANC^ECXUTL4(ECNL,$PIECE(DATA2,U,10))
+66 ;
+67 IF ECXFLAG
DO FILE
QUIT
+68 NEW PIECE,FILE
+69 SET FILE="NO"
+70 FOR PIECE=1,2,3,4,5,6
Begin DoDot:1
+71 IF $PIECE(ECODE0,U,PIECE)>ECTHLD
SET FILE="YES"
+72 IF $PIECE(ECODE0,U,PIECE)<0
SET FILE="YES"
End DoDot:1
+73 ;
+74 IF FILE="YES"
DO FILE
if ECXERR
QUIT
+75 QUIT
+76 ;
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
