- 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 Feb 18, 2025@23:20:45 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
