ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ;4/5/19 15:40
;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99,105,112,128,127,132,144,149,154,161,166,170,174,184**;Dec 22, 1997;Build 124
;
; Reference to ^SRF in ICR #103
;
BEG ;entry point from option
D SETUP I ECFILE="" Q
D ^ECXTRAC,^ECXKILL
Q
;
START ;
K ^TMP($J,"ECXS"),^TMP($J,"ECXCL")
S QFLG=0,ECED=ECED+.3,ECD=ECSD1
F S ECD=$O(^SRF("AC",ECD)),ECD0=0 Q:('ECD)!(ECD>ECED)!(QFLG) D
.F S ECD0=$O(^SRF("AC",ECD,ECD0)) Q:'ECD0 D
..I $D(^SRF(ECD0,0)) S EC=^SRF(ECD0,0),ECXDFN=+$P(EC,U),ECXVISIT=$P(EC,U,15) D STUFF Q:QFLG
K ^TMP($J,"ECXS"),^TMP($J,"ECXCL")
Q
;
STUFF ;gather data
N J,X,Y,PP,DATA1,DATA2,DATAOP,ARR,ERR,SUB,MOD,TIMEDIF ;174 Removed retired variables
N ECPRO,ECXORCT,ECXPTHA,ECXNPRFI,ECXPA,ECXPAPC,ECSRPC,ECATPC,ECSAPC
N ECXCRST,ECXSTCD,ECXCLIN,EC1A,EC2A,ECPQ,ECQA,EC1APC,EC2APC,ECPQPC
N ECQAPC,EC1ANPI,EC2ANPI,ECPQNPI,ECQANPI
N ECXORCET,ECXORCST,ECXTPOOR ;ECX*128
N ECICD10,ECICD101,ECICD102,ECICD103,ECICD104,ECICD105,ECXCONC ;ECX*144 CVW
N ECXCLST,ECXECL,CODE,ECNTIME,ECSTIME,ECATIME,ECXNONMS ;144,154,161,166
N ECXTEMPW,ECXTEMPD,ECXSTANO ;166 Patient Division
N ECXORG1,ECXORG2,ECXORG3,ORG,TYPE,NUM ;166 Organs to be transplanted
N ECXASIH ;170
N ECXNMPI,ECXCERN,ECXSIGI ;184
S (ECXPODX,ECXPODX1,ECXPODX2,ECXPODX3,ECXPODX4,ECXPODX5)="" ;161 Old ICD9 codes, now placeholders and set to null
S ECXDATE=ECD,ECXERR=0,ECXQ="",ECXCONC=""
;retrieve demographic variables
Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;")
I ECXADMDT="" S ECXADD=ECXADMDT
I ECXADMDT'="" S ECXADD=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)
S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT)
I 'OK S ECXERR=1 K ECXPAT Q
S ECXNMPI=ECXPAT("MPI") ;184 New MPI
S ECXSIGI=ECXPAT("SIGI") ;184 Self Identified Gender
;OEF/OIF DATA
S ECXOEF=ECXPAT("ECXOEF")
S ECXOEFDT=ECXPAT("ECXOEFDT")
S ECXVNS=ECXPAT("VIETNAM") ; 144 Vietnam Status
S ECXCLST=ECXPAT("CL STAT") ;144
S ECXSVCI=ECXPAT("COMBSVCI") ;149 COMBAT SVC IND
S ECXSVCL=ECXPAT("COMBSVCL") ;149 COMBAT SVC LOC
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(^SRO(136,ECD0,0)):^(0),1:"")
S ECNO=$G(^SRF(ECD0,"NON"))
; if VISIT data exist get encounter data
; ECX*112
S ECXVST=$P(^SRF(ECD0,0),U,15) D:ECXVST'=""
. Q:'$D(^AUPNVSIT(ECXVST,800))
. S ECENSC=$P(^AUPNVSIT(ECXVST,800),U,1)
. S ECENSC=$S(ECENSC=0:"N",ECENSC=1:"Y",1:"")
;get data
S ECSR=$P(DATA1,U,4),(ECATNPI,ECSANPI,ECSRNPI)="",ECAT=$P(DATA1,U,13)
S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)
S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U)
;-Time patient in OR room (Nurse Time)
S ECXTM=$$ECXTIME^ECXUTL($P(DATA2,U,10))
S ECXDIV=$S($D(^SRF(ECD0,8)):^(8),1:ECINST)
N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV) ;Production Division
S ECSA=$P($G(^SRF(ECD0,.3)),U,4),ECO=$P(EC0,U,2)
S ECSANPI=$$NPI^XUSNPI("Individual_ID",ECSA,ECXDATE)
S:+ECSANPI'>0 ECSANPI="" S ECSANPI=$P(ECSANPI,U)
;get principle anesthetist and person class DBIA #103
S ECXPA=$P($G(^SRF(ECD0,.3)),U,1)
S ECPANPI=$$NPI^XUSNPI("Individual_ID",ECXPA,ECXDATE)
S:+ECPANPI'>0 ECPANPI="" S ECPANPI=$P(ECPANPI,U)
S ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE)
;get first asst, 2nd asst, perfusionist, and asst perfusionist
S EC1A=$P(DATA1,U,5),EC2A=$P(DATA1,U,6),ECPQ=$P(DATA1,U,19),ECQA=$P(DATA1,U,20)
S EC1ANPI=$$NPI^XUSNPI("Individual_ID",EC1A,ECXDATE)
S:+EC1ANPI'>0 EC1ANPI="" S EC1ANPI=$P(EC1ANPI,U)
S EC2ANPI=$$NPI^XUSNPI("Individual_ID",EC2A,ECXDATE)
S:+EC2ANPI'>0 EC2ANPI="" S EC2ANPI=$P(EC2ANPI,U)
S ECPQNPI=$$NPI^XUSNPI("Individual_ID",ECPQ,ECXDATE)
S:+ECPQNPI'>0 ECPQNPI="" S ECPQNPI=$P(ECPQNPI,U)
S ECQANPI=$$NPI^XUSNPI("Individual_ID",ECQA,ECXDATE)
S:+ECQANPI'>0 ECQANPI="" S ECQANPI=$P(ECQANPI,U)
S ECORTY=$P($G(^SRS(+ECO,2)),U),ECO=$P($G(^SRS(+ECO,0)),U)
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"
;get classification information
S (ECXAO,ECXHNC,ECXSHAD,ECXSHADI,ECXECL)="" I ECXVISIT'="" D ;144
.D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR
.S ECXAO=$G(ECXVIST("AO")),ECXHNC=$G(ECXVIST("HNC"))
.S ECENRI=$G(ECXVIST("IR")),ECENMST=$G(ECXVIST("MST"))
.S ECENEC=$G(ECXVIST("PGE")),ECXSHAD=$G(ECXVIST("SHAD"))
.S ECXECL=$G(ECXVIST("ENCCL")) ;144
; - Head and Neck Cancer Indicator
S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
; - Shad Encounter Field
S ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
;look for non-OR
S (ECNT,ECNL,ECXDSSD,ECXSTCD,ECXCLIN,ECXCRST,ECXNONMS)="" ;174
I $P(ECNO,U)="Y" D
.S ECSR=$P(ECNO,U,6),ECAT=$P(ECNO,U,7)
.S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)
.S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U)
.S ECATNPI=$$NPI^XUSNPI("Individual_ID",ECAT,ECXDATE)
.S:+ECATNPI'>0 ECATNPI="" S ECATNPI=$P(ECATNPI,U)
.S ECXTM=$$ECXTIME^ECXUTL($P(ECNO,U,4))
.S A1=$P(ECNO,U,5),A2=$P(ECNO,U,4),TIME="##" D:(A1&A2) TIME S ECNT=TIME
.S ECNL=+$P(ECNO,U,2),ECNL=$P($G(^ECX(728.44,ECNL,0)),U,9) ;174
.S:ECNL="" ECNL="UNKNOWN"
.; tjl 166 - Get medical specialty of non-OR provider
.S ECXNONMS=$P(ECNO,U,8)
;
;- Get credit stop, stop code and clinic
D SUR^ECXUTL6(.ECXCRST,.ECXSTCD,.ECXCLIN) ;174
;166 tjl - Set Patient Division based on Movement Number
S ECXSTANO="" I $D(^DGPM(+ECXMN,0)) D
. S ECXTEMPW=$P($G(^DGPM(ECXMN,0)),U,6)
. S ECXTEMPD=$P($G(^DIC(42,+ECXTEMPW,0)),U,11)
. S ECXSTANO=$$GETDIV^ECXDEPT(ECXTEMPD)
;
;166 For non-OR cases where Pat Div is empty, get value based on Clinic
I $P(ECNO,U)="Y",ECXSTANO="" S ECXSTANO=$$GETDIV^ECXDEPT($$GET1^DIQ(44,ECXCLIN,3.5,"I"))
;
;166 If Patient Division is still empty, set it to the Prod Div Code
I ECXSTANO="" S ECXSTANO=ECXPDIV
;
;- If surgery cancelled/aborted quit and go to next record
S ECCAN=$P($G(^SRF(ECD0,30)),U)
I +ECCAN S ECCAN=$$CANC^ECXUTL4(ECNL,$P(DATA2,U,10))
;on hold for ECXDSSD and ECXDSSP I $P($G(^SRF(ECD0,30)),U) Q
;get service of attending surgeon
S ECATSV=$P($G(^DIC(49,+$G(^VA(200,+ECAT,5)),730)),U)
;
;get surgeon, attending and anesthesia super person classes
;get 1st asst, 2nd asst, perfusionist, and asst perfusionst person class
S ECSRPC=$$PRVCLASS^ECXUTL(ECSR,ECXDATE)
S ECATPC=$$PRVCLASS^ECXUTL(ECAT,ECXDATE)
S ECSAPC=$$PRVCLASS^ECXUTL(ECSA,ECXDATE)
S EC1APC=$$PRVCLASS^ECXUTL(EC1A,ECXDATE)
S EC2APC=$$PRVCLASS^ECXUTL(EC2A,ECXDATE)
S ECPQPC=$$PRVCLASS^ECXUTL(ECPQ,ECXDATE)
S ECQAPC=$$PRVCLASS^ECXUTL(ECQA,ECXDATE)
;
;add leading 2s for pointer to 200
S:ECAT ECAT="2"_ECAT S:ECSR ECSR="2"_ECSR S:ECSA ECSA="2"_ECSA
;add leading 2 to principle anesthetist IEN
S:ECXPA ECXPA="2"_ECXPA
;add leading 2s for 1st asst, 2nd asst, perfusionist, asst perfusionist
S:EC1A EC1A="2"_EC1A S:EC2A EC2A="2"_EC2A S:ECPQ ECPQ="2"_ECPQ S:ECQA ECQA="2"_ECQA
;anesthesia technique
S ECANE="",PP=""
I $D(^SRF(ECD0,6,0)) S ECXJ=0 D
.F S ECXJ=$O(^SRF(ECD0,6,ECXJ)) Q:('ECXJ)!(ECANE]"") D
..S PP=$P($G(^(ECXJ,0)),U,3) S:PP="Y" ECANE=$P(^(0),U,1)
.I ECANE="" S ECXJ=$O(^SRF(ECD0,6,0)) I ECXJ S ECANE=$P(^SRF(ECD0,6,ECXJ,0),U,1)
;get primary procedure
;ecode0=p^cpt code^^patient time^operation time^anesthesia time
S ECPT=+$P(DATAOP,U,2),ECXCMOD=""
K ARR,ERR D FIELD^DID(130,28,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D
.K ARR,ERR D FIELD^DID(130,28,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR")
.Q:$D(ERR("DIERR"))
.S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0
.F S MOD=$O(^SRF(ECD0,SUB,MOD)) Q:MOD'>0 D
..S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";"
S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD)
S ECODE0="P"_U_U ;ECPT_U
S (ECNTIME,ECSTIME,ECATIME)="" ;161
F J="10,12","2,3","1,4" D
.S A2=$P(DATA2,U,$P(J,",")),A1=$P(DATA2,U,$P(J,",",2)),TIME="##"
.I (A1&A2)&(+J=10) D TIME S ECNTIME=TIME
.I +J=1 D ANTIME S ECATIME=TIME ;161
.I (A1&A2)&(+J=2) D
..;
..;-Operation Time (Surgeon Time)
..;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1)
..S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900
..S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF)
..S TIME=$TR($J(TIMEDIF,4,0)," ")
..S:TIME<0 TIME="###"
..S:TIME ECSTIME=TIME
.S ECODE0=ECODE0_U_TIME K TIME
; -Recovery Room Time
S ECRR=""
I $D(^SRF(ECD0,1.1)) D
.S A1=$P(^(1.1),U,8),A2=$P(^(1.1),U,7),TIME="##" D:(A1&A2) TIME
.S ECRR=TIME K TIME
I ECNL]"" S $P(ECODE0,U,5)=ECNT
;
; -OR Clean Time in 15 min increments DBIA #103
;
; ECX*3.0*128 - Correct the calculation of OR Clean Time.
S ECXORCT=0
; Set local variables. ECX*128
S ECXTPOOR=$P($G(DATA2),U,12),ECXORCST=$P($G(DATA2),U,13),ECXORCET=$P($G(DATA2),U,14)
I (ECXORCET'=""),(ECXORCST'="") D
.S ECXORCT=($$FMDIFF^XLFDT(ECXORCET,ECXORCST,2)/60)/15
I 'ECXORCT,(ECXORCET'=""),(ECXTPOOR'="") D
.S ECXORCT=($$FMDIFF^XLFDT(ECXORCET,ECXTPOOR,2)/60)/15
; Make sure the final OR CLEAN TIME is an integer by rounding
; up for any decimal value ECX*3.0*128
I ECXORCT>0 S ECXORCT=$J(ECXORCT+.4999,0,0)
; -If no OR clean time recorded set it to 2
I ECXORCT'>0 S ECXORCT=2
;
; -PT in hold area time in 15 min increments DBIA #103
I $P($G(DATA2),U,10),$P($G(DATA2),U,15) D
.S ECXPTHA=($$FMDIFF^XLFDT($P($G(DATA2),U,10),$P($G(DATA2),U,15),2)/60)/15
.S CON=$P($G(^SRF(ECD0,"CON")),U)
.I CON S ECXPTHA=ECXPTHA/2,ECXCONC="C" ;144 Concurrent Case
.S ECXPTHA=$TR($J(ECXPTHA,3,0)," ")
; -If hold time is =<0 set it to ""
S:$G(ECXPTHA)'>0 ECXPTHA=""
;
;- get ASA CLASS
S ECASA=$$GET1^DIQ(132.8,$$GET1^DIQ(130,ECD0,1.13,"I"),.01)
;
;- Observation Patient Indicator (yes/no)
S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL)
;
; ******* - PATCH 127, ADD PATCAT CODE ********
S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
;- set national patient record flag if exist
D NPRF^ECXUTL5
;
;- If no encounter number don't file record
S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTCD,ECSS) Q:ECXENC=""
;
;- Get postop diagnosis codes
I $$SURPODX^ECXUTL6(.ECICD10,.ECICD101,.ECICD102,.ECICD103,.ECICD104,.ECICD105) ;161
;166 Get organs transplanted (max 3)
I $D(^SRF(ECD0,63)) S NUM=0 F S NUM=$O(^SRF(ECD0,63,NUM)) Q:'+NUM!($G(ORG)'<3) D
.S TYPE=$P($G(^SRF(ECD0,63,NUM,0)),U)
.I TYPE'="" S ORG=+$G(ORG)+1 S @("ECXORG"_ORG)=$S(TYPE=1:"HART",TYPE=2:"LUNG",TYPE=3:"KDNY",TYPE=4:"LIVR",TYPE=5:"PCRS",TYPE=6:"INTN",TYPE=7:"OTHR",1:"")
.Q
;
I $G(ECXASIH) S ECXA="A" ;170
D FILE^ECXSURG1
;get secondary procedures
;ecode0=s^cpt code
S ECXJ=0
F S ECXJ=$O(^SRO(136,ECD0,3,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)),$D(^(0)),$P(^(0),"^")]"" D
.;S ECPT=$P(^SRF(ECD0,13,ECXJ,2),U),ECXCMOD=""
.S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),U),ECXMOD=""
.S ECPT=$P(^(0),"^"),ECXCMOD=""
.K ARR,ERR
.D FIELD^DID(130.16,4,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D
..K ARR,ERR
..D FIELD^DID(130.16,4,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR")
..Q:$D(ERR("DIERR"))
..S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0
..F S MOD=$O(^SRF(ECD0,13,ECXJ,SUB,MOD)) Q:MOD'>0 S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";"
.S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD)
.S ECODE0="S"_U ;_ECPT
.D FILE^ECXSURG1
;get prostheses
;ecode0=i^^^^^^prosthesis^old qty field (null)
S ECXJ=0
F S ECXJ=$O(^SRF(ECD0,1,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)) D
.S ECXP=+^SRF(ECD0,1,ECXJ,0),ECXQ=$P($G(^(1)),U,2) S:'ECXQ ECXQ=1
.S ECODE0="I"_U_U_U_U_U_U_ECXP_U_U
.D FILE^ECXSURG1
Q
;
;
TIME ; given date/time get increment
;A1=later, A2=earlier, TIME=difference
N CON,TIMEDIF
S CON=$P($G(^SRF(ECD0,"CON")),U)
;
;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1)
S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900
S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF)
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
;
ANTIME ;161 Section added to determine anesthesia time
N STDT,ENDT,SUB,NODE,VCODES
S TIME=""
I A1&(A2) D TIME Q ;If anesthesia fields have values, determine time
;If either anesthesia time field is null, search anes multiple
S (STDT,ENDT)="",SUB=0
F S SUB=$O(^SRF(ECD0,50,SUB)) Q:'+SUB S NODE=$G(^SRF(ECD0,50,SUB,0)) D
.I $P(NODE,U) S STDT=$S(STDT="":$P(NODE,U),$P(NODE,U)<STDT:$P(NODE,U),1:STDT) ;find earliest start date
.I $P(NODE,U,2) S ENDT=$S($P(NODE,U,2)>ENDT:$P(NODE,U,2),1:ENDT) ;find latest end date
I STDT&(ENDT) S A1=ENDT,A2=STDT D TIME Q ;Use anes multiple dates to determine time
S VCODES="^V180200^V180201^V180202^V180203^V180204^V180205^V100500^V110400^V110401^V110402^V110403^" ;VA person class list
I VCODES[("^"_ECSAPC_"^")!(VCODES[("^"_ECXPAPC_"^")) I ECNTIME,ECNTIME'>97.5 S TIME=$J(ECNTIME+2,2,1) ;If principle anesthetist or supervising anesthesiologis has one of the person classes, add two 15 minute segments to the patient's room time
Q ;If no calculations done, time will be returned as null
SETUP ;Set required input for ECXTRAC
S ECHEAD="SUR"
D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSURG 13178 printed Oct 16, 2024@17:54:45 Page 2
ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ;4/5/19 15:40
+1 ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99,105,112,128,127,132,144,149,154,161,166,170,174,184**;Dec 22, 1997;Build 124
+2 ;
+3 ; Reference to ^SRF in ICR #103
+4 ;
BEG ;entry point from option
+1 DO SETUP
IF ECFILE=""
QUIT
+2 DO ^ECXTRAC
DO ^ECXKILL
+3 QUIT
+4 ;
START ;
+1 KILL ^TMP($JOB,"ECXS"),^TMP($JOB,"ECXCL")
+2 SET QFLG=0
SET ECED=ECED+.3
SET ECD=ECSD1
+3 FOR
SET ECD=$ORDER(^SRF("AC",ECD))
SET ECD0=0
if ('ECD)!(ECD>ECED)!(QFLG)
QUIT
Begin DoDot:1
+4 FOR
SET ECD0=$ORDER(^SRF("AC",ECD,ECD0))
if 'ECD0
QUIT
Begin DoDot:2
+5 IF $DATA(^SRF(ECD0,0))
SET EC=^SRF(ECD0,0)
SET ECXDFN=+$PIECE(EC,U)
SET ECXVISIT=$PIECE(EC,U,15)
DO STUFF
if QFLG
QUIT
End DoDot:2
End DoDot:1
+6 KILL ^TMP($JOB,"ECXS"),^TMP($JOB,"ECXCL")
+7 QUIT
+8 ;
STUFF ;gather data
+1 ;174 Removed retired variables
NEW J,X,Y,PP,DATA1,DATA2,DATAOP,ARR,ERR,SUB,MOD,TIMEDIF
+2 NEW ECPRO,ECXORCT,ECXPTHA,ECXNPRFI,ECXPA,ECXPAPC,ECSRPC,ECATPC,ECSAPC
+3 NEW ECXCRST,ECXSTCD,ECXCLIN,EC1A,EC2A,ECPQ,ECQA,EC1APC,EC2APC,ECPQPC
+4 NEW ECQAPC,EC1ANPI,EC2ANPI,ECPQNPI,ECQANPI
+5 ;ECX*128
NEW ECXORCET,ECXORCST,ECXTPOOR
+6 ;ECX*144 CVW
NEW ECICD10,ECICD101,ECICD102,ECICD103,ECICD104,ECICD105,ECXCONC
+7 ;144,154,161,166
NEW ECXCLST,ECXECL,CODE,ECNTIME,ECSTIME,ECATIME,ECXNONMS
+8 ;166 Patient Division
NEW ECXTEMPW,ECXTEMPD,ECXSTANO
+9 ;166 Organs to be transplanted
NEW ECXORG1,ECXORG2,ECXORG3,ORG,TYPE,NUM
+10 ;170
NEW ECXASIH
+11 ;184
NEW ECXNMPI,ECXCERN,ECXSIGI
+12 ;161 Old ICD9 codes, now placeholders and set to null
SET (ECXPODX,ECXPODX1,ECXPODX2,ECXPODX3,ECXPODX4,ECXPODX5)=""
+13 SET ECXDATE=ECD
SET ECXERR=0
SET ECXQ=""
SET ECXCONC=""
+14 ;retrieve demographic variables
+15 if '$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;")
QUIT
+16 IF ECXADMDT=""
SET ECXADD=ECXADMDT
+17 IF ECXADMDT'=""
SET ECXADD=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM)
+18 SET OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT)
+19 IF 'OK
SET ECXERR=1
KILL ECXPAT
QUIT
+20 ;184 New MPI
SET ECXNMPI=ECXPAT("MPI")
+21 ;184 Self Identified Gender
SET ECXSIGI=ECXPAT("SIGI")
+22 ;OEF/OIF DATA
+23 SET ECXOEF=ECXPAT("ECXOEF")
+24 SET ECXOEFDT=ECXPAT("ECXOEFDT")
+25 ; 144 Vietnam Status
SET ECXVNS=ECXPAT("VIETNAM")
+26 ;144
SET ECXCLST=ECXPAT("CL STAT")
+27 ;149 COMBAT SVC IND
SET ECXSVCI=ECXPAT("COMBSVCI")
+28 ;149 COMBAT SVC LOC
SET ECXSVCL=ECXPAT("COMBSVCL")
+29 SET EC0=^SRF(ECD0,0)
+30 SET DATA1=$SELECT($DATA(^SRF(ECD0,.1)):^(.1),1:"")
+31 SET DATA2=$SELECT($DATA(^SRF(ECD0,.2)):^(.2),1:"")
+32 SET DATAOP=$SELECT($DATA(^SRO(136,ECD0,0)):^(0),1:"")
+33 SET ECNO=$GET(^SRF(ECD0,"NON"))
+34 ; if VISIT data exist get encounter data
+35 ; ECX*112
+36 SET ECXVST=$PIECE(^SRF(ECD0,0),U,15)
if ECXVST'=""
Begin DoDot:1
+37 if '$DATA(^AUPNVSIT(ECXVST,800))
QUIT
+38 SET ECENSC=$PIECE(^AUPNVSIT(ECXVST,800),U,1)
+39 SET ECENSC=$SELECT(ECENSC=0:"N",ECENSC=1:"Y",1:"")
End DoDot:1
+40 ;get data
+41 SET ECSR=$PIECE(DATA1,U,4)
SET (ECATNPI,ECSANPI,ECSRNPI)=""
SET ECAT=$PIECE(DATA1,U,13)
+42 SET ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)
+43 if +ECSRNPI'>0
SET ECSRNPI=""
SET ECSRNPI=$PIECE(ECSRNPI,U)
+44 ;-Time patient in OR room (Nurse Time)
+45 SET ECXTM=$$ECXTIME^ECXUTL($PIECE(DATA2,U,10))
+46 SET ECXDIV=$SELECT($DATA(^SRF(ECD0,8)):^(8),1:ECINST)
+47 ;Production Division
NEW ECXPDIV
SET ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV)
+48 SET ECSA=$PIECE($GET(^SRF(ECD0,.3)),U,4)
SET ECO=$PIECE(EC0,U,2)
+49 SET ECSANPI=$$NPI^XUSNPI("Individual_ID",ECSA,ECXDATE)
+50 if +ECSANPI'>0
SET ECSANPI=""
SET ECSANPI=$PIECE(ECSANPI,U)
+51 ;get principle anesthetist and person class DBIA #103
+52 SET ECXPA=$PIECE($GET(^SRF(ECD0,.3)),U,1)
+53 SET ECPANPI=$$NPI^XUSNPI("Individual_ID",ECXPA,ECXDATE)
+54 if +ECPANPI'>0
SET ECPANPI=""
SET ECPANPI=$PIECE(ECPANPI,U)
+55 SET ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE)
+56 ;get first asst, 2nd asst, perfusionist, and asst perfusionist
+57 SET EC1A=$PIECE(DATA1,U,5)
SET EC2A=$PIECE(DATA1,U,6)
SET ECPQ=$PIECE(DATA1,U,19)
SET ECQA=$PIECE(DATA1,U,20)
+58 SET EC1ANPI=$$NPI^XUSNPI("Individual_ID",EC1A,ECXDATE)
+59 if +EC1ANPI'>0
SET EC1ANPI=""
SET EC1ANPI=$PIECE(EC1ANPI,U)
+60 SET EC2ANPI=$$NPI^XUSNPI("Individual_ID",EC2A,ECXDATE)
+61 if +EC2ANPI'>0
SET EC2ANPI=""
SET EC2ANPI=$PIECE(EC2ANPI,U)
+62 SET ECPQNPI=$$NPI^XUSNPI("Individual_ID",ECPQ,ECXDATE)
+63 if +ECPQNPI'>0
SET ECPQNPI=""
SET ECPQNPI=$PIECE(ECPQNPI,U)
+64 SET ECQANPI=$$NPI^XUSNPI("Individual_ID",ECQA,ECXDATE)
+65 if +ECQANPI'>0
SET ECQANPI=""
SET ECQANPI=$PIECE(ECQANPI,U)
+66 SET ECORTY=$PIECE($GET(^SRS(+ECO,2)),U)
SET ECO=$PIECE($GET(^SRS(+ECO,0)),U)
+67 SET ECSS=$PIECE($GET(^SRO(137.45,+$PIECE(EC0,U,4),0)),U,2)
+68 SET ECSS=$$RJ^XLFSTR($PIECE($GET(^DIC(45.3,+ECSS,0)),U),3,0)
+69 if ECSS="000"
SET ECSS="999"
+70 ;get classification information
+71 ;144
SET (ECXAO,ECXHNC,ECXSHAD,ECXSHADI,ECXECL)=""
IF ECXVISIT'=""
Begin DoDot:1
+72 DO VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR)
IF ECXERR
KILL ECXERR
+73 SET ECXAO=$GET(ECXVIST("AO"))
SET ECXHNC=$GET(ECXVIST("HNC"))
+74 SET ECENRI=$GET(ECXVIST("IR"))
SET ECENMST=$GET(ECXVIST("MST"))
+75 SET ECENEC=$GET(ECXVIST("PGE"))
SET ECXSHAD=$GET(ECXVIST("SHAD"))
+76 ;144
SET ECXECL=$GET(ECXVIST("ENCCL"))
End DoDot:1
+77 ; - Head and Neck Cancer Indicator
+78 SET ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
+79 ; - Shad Encounter Field
+80 SET ECXSHADI=$$SHAD^ECXUTL4(ECXDFN)
+81 ;look for non-OR
+82 ;174
SET (ECNT,ECNL,ECXDSSD,ECXSTCD,ECXCLIN,ECXCRST,ECXNONMS)=""
+83 IF $PIECE(ECNO,U)="Y"
Begin DoDot:1
+84 SET ECSR=$PIECE(ECNO,U,6)
SET ECAT=$PIECE(ECNO,U,7)
+85 SET ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE)
+86 if +ECSRNPI'>0
SET ECSRNPI=""
SET ECSRNPI=$PIECE(ECSRNPI,U)
+87 SET ECATNPI=$$NPI^XUSNPI("Individual_ID",ECAT,ECXDATE)
+88 if +ECATNPI'>0
SET ECATNPI=""
SET ECATNPI=$PIECE(ECATNPI,U)
+89 SET ECXTM=$$ECXTIME^ECXUTL($PIECE(ECNO,U,4))
+90 SET A1=$PIECE(ECNO,U,5)
SET A2=$PIECE(ECNO,U,4)
SET TIME="##"
if (A1&A2)
DO TIME
SET ECNT=TIME
+91 ;174
SET ECNL=+$PIECE(ECNO,U,2)
SET ECNL=$PIECE($GET(^ECX(728.44,ECNL,0)),U,9)
+92 if ECNL=""
SET ECNL="UNKNOWN"
+93 ; tjl 166 - Get medical specialty of non-OR provider
+94 SET ECXNONMS=$PIECE(ECNO,U,8)
End DoDot:1
+95 ;
+96 ;- Get credit stop, stop code and clinic
+97 ;174
DO SUR^ECXUTL6(.ECXCRST,.ECXSTCD,.ECXCLIN)
+98 ;166 tjl - Set Patient Division based on Movement Number
+99 SET ECXSTANO=""
IF $DATA(^DGPM(+ECXMN,0))
Begin DoDot:1
+100 SET ECXTEMPW=$PIECE($GET(^DGPM(ECXMN,0)),U,6)
+101 SET ECXTEMPD=$PIECE($GET(^DIC(42,+ECXTEMPW,0)),U,11)
+102 SET ECXSTANO=$$GETDIV^ECXDEPT(ECXTEMPD)
End DoDot:1
+103 ;
+104 ;166 For non-OR cases where Pat Div is empty, get value based on Clinic
+105 IF $PIECE(ECNO,U)="Y"
IF ECXSTANO=""
SET ECXSTANO=$$GETDIV^ECXDEPT($$GET1^DIQ(44,ECXCLIN,3.5,"I"))
+106 ;
+107 ;166 If Patient Division is still empty, set it to the Prod Div Code
+108 IF ECXSTANO=""
SET ECXSTANO=ECXPDIV
+109 ;
+110 ;- If surgery cancelled/aborted quit and go to next record
+111 SET ECCAN=$PIECE($GET(^SRF(ECD0,30)),U)
+112 IF +ECCAN
SET ECCAN=$$CANC^ECXUTL4(ECNL,$PIECE(DATA2,U,10))
+113 ;on hold for ECXDSSD and ECXDSSP I $P($G(^SRF(ECD0,30)),U) Q
+114 ;get service of attending surgeon
+115 SET ECATSV=$PIECE($GET(^DIC(49,+$GET(^VA(200,+ECAT,5)),730)),U)
+116 ;
+117 ;get surgeon, attending and anesthesia super person classes
+118 ;get 1st asst, 2nd asst, perfusionist, and asst perfusionst person class
+119 SET ECSRPC=$$PRVCLASS^ECXUTL(ECSR,ECXDATE)
+120 SET ECATPC=$$PRVCLASS^ECXUTL(ECAT,ECXDATE)
+121 SET ECSAPC=$$PRVCLASS^ECXUTL(ECSA,ECXDATE)
+122 SET EC1APC=$$PRVCLASS^ECXUTL(EC1A,ECXDATE)
+123 SET EC2APC=$$PRVCLASS^ECXUTL(EC2A,ECXDATE)
+124 SET ECPQPC=$$PRVCLASS^ECXUTL(ECPQ,ECXDATE)
+125 SET ECQAPC=$$PRVCLASS^ECXUTL(ECQA,ECXDATE)
+126 ;
+127 ;add leading 2s for pointer to 200
+128 if ECAT
SET ECAT="2"_ECAT
if ECSR
SET ECSR="2"_ECSR
if ECSA
SET ECSA="2"_ECSA
+129 ;add leading 2 to principle anesthetist IEN
+130 if ECXPA
SET ECXPA="2"_ECXPA
+131 ;add leading 2s for 1st asst, 2nd asst, perfusionist, asst perfusionist
+132 if EC1A
SET EC1A="2"_EC1A
if EC2A
SET EC2A="2"_EC2A
if ECPQ
SET ECPQ="2"_ECPQ
if ECQA
SET ECQA="2"_ECQA
+133 ;anesthesia technique
+134 SET ECANE=""
SET PP=""
+135 IF $DATA(^SRF(ECD0,6,0))
SET ECXJ=0
Begin DoDot:1
+136 FOR
SET ECXJ=$ORDER(^SRF(ECD0,6,ECXJ))
if ('ECXJ)!(ECANE]"")
QUIT
Begin DoDot:2
+137 SET PP=$PIECE($GET(^(ECXJ,0)),U,3)
if PP="Y"
SET ECANE=$PIECE(^(0),U,1)
End DoDot:2
+138 IF ECANE=""
SET ECXJ=$ORDER(^SRF(ECD0,6,0))
IF ECXJ
SET ECANE=$PIECE(^SRF(ECD0,6,ECXJ,0),U,1)
End DoDot:1
+139 ;get primary procedure
+140 ;ecode0=p^cpt code^^patient time^operation time^anesthesia time
+141 SET ECPT=+$PIECE(DATAOP,U,2)
SET ECXCMOD=""
+142 KILL ARR,ERR
DO FIELD^DID(130,28,,"LABEL","ARR","ERR")
IF $DATA(ARR("LABEL"))
Begin DoDot:1
+143 KILL ARR,ERR
DO FIELD^DID(130,28,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR")
+144 if $DATA(ERR("DIERR"))
QUIT
+145 SET SUB=$PIECE(ARR("GLOBAL SUBSCRIPT LOCATION"),";")
SET MOD=0
+146 FOR
SET MOD=$ORDER(^SRF(ECD0,SUB,MOD))
if MOD'>0
QUIT
Begin DoDot:2
+147 SET ECXCMOD=ECXCMOD_$PIECE(^(MOD,0),U)_";"
End DoDot:2
End DoDot:1
+148 SET ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD)
+149 ;ECPT_U
SET ECODE0="P"_U_U
+150 ;161
SET (ECNTIME,ECSTIME,ECATIME)=""
+151 FOR J="10,12","2,3","1,4"
Begin DoDot:1
+152 SET A2=$PIECE(DATA2,U,$PIECE(J,","))
SET A1=$PIECE(DATA2,U,$PIECE(J,",",2))
SET TIME="##"
+153 IF (A1&A2)&(+J=10)
DO TIME
SET ECNTIME=TIME
+154 ;161
IF +J=1
DO ANTIME
SET ECATIME=TIME
+155 IF (A1&A2)&(+J=2)
Begin DoDot:2
+156 ;
+157 ;-Operation Time (Surgeon Time)
+158 ;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1)
+159 SET TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900
+160 SET TIMEDIF=$SELECT(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF)
+161 SET TIME=$TRANSLATE($JUSTIFY(TIMEDIF,4,0)," ")
+162 if TIME<0
SET TIME="###"
+163 if TIME
SET ECSTIME=TIME
End DoDot:2
+164 SET ECODE0=ECODE0_U_TIME
KILL TIME
End DoDot:1
+165 ; -Recovery Room Time
+166 SET ECRR=""
+167 IF $DATA(^SRF(ECD0,1.1))
Begin DoDot:1
+168 SET A1=$PIECE(^(1.1),U,8)
SET A2=$PIECE(^(1.1),U,7)
SET TIME="##"
if (A1&A2)
DO TIME
+169 SET ECRR=TIME
KILL TIME
End DoDot:1
+170 IF ECNL]""
SET $PIECE(ECODE0,U,5)=ECNT
+171 ;
+172 ; -OR Clean Time in 15 min increments DBIA #103
+173 ;
+174 ; ECX*3.0*128 - Correct the calculation of OR Clean Time.
+175 SET ECXORCT=0
+176 ; Set local variables. ECX*128
+177 SET ECXTPOOR=$PIECE($GET(DATA2),U,12)
SET ECXORCST=$PIECE($GET(DATA2),U,13)
SET ECXORCET=$PIECE($GET(DATA2),U,14)
+178 IF (ECXORCET'="")
IF (ECXORCST'="")
Begin DoDot:1
+179 SET ECXORCT=($$FMDIFF^XLFDT(ECXORCET,ECXORCST,2)/60)/15
End DoDot:1
+180 IF 'ECXORCT
IF (ECXORCET'="")
IF (ECXTPOOR'="")
Begin DoDot:1
+181 SET ECXORCT=($$FMDIFF^XLFDT(ECXORCET,ECXTPOOR,2)/60)/15
End DoDot:1
+182 ; Make sure the final OR CLEAN TIME is an integer by rounding
+183 ; up for any decimal value ECX*3.0*128
+184 IF ECXORCT>0
SET ECXORCT=$JUSTIFY(ECXORCT+.4999,0,0)
+185 ; -If no OR clean time recorded set it to 2
+186 IF ECXORCT'>0
SET ECXORCT=2
+187 ;
+188 ; -PT in hold area time in 15 min increments DBIA #103
+189 IF $PIECE($GET(DATA2),U,10)
IF $PIECE($GET(DATA2),U,15)
Begin DoDot:1
+190 SET ECXPTHA=($$FMDIFF^XLFDT($PIECE($GET(DATA2),U,10),$PIECE($GET(DATA2),U,15),2)/60)/15
+191 SET CON=$PIECE($GET(^SRF(ECD0,"CON")),U)
+192 ;144 Concurrent Case
IF CON
SET ECXPTHA=ECXPTHA/2
SET ECXCONC="C"
+193 SET ECXPTHA=$TRANSLATE($JUSTIFY(ECXPTHA,3,0)," ")
End DoDot:1
+194 ; -If hold time is =<0 set it to ""
+195 if $GET(ECXPTHA)'>0
SET ECXPTHA=""
+196 ;
+197 ;- get ASA CLASS
+198 SET ECASA=$$GET1^DIQ(132.8,$$GET1^DIQ(130,ECD0,1.13,"I"),.01)
+199 ;
+200 ;- Observation Patient Indicator (yes/no)
+201 SET ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL)
+202 ;
+203 ; ******* - PATCH 127, ADD PATCAT CODE ********
+204 SET ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
+205 ;- set national patient record flag if exist
+206 DO NPRF^ECXUTL5
+207 ;
+208 ;- If no encounter number don't file record
+209 SET ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTCD,ECSS)
if ECXENC=""
QUIT
+210 ;
+211 ;- Get postop diagnosis codes
+212 ;161
IF $$SURPODX^ECXUTL6(.ECICD10,.ECICD101,.ECICD102,.ECICD103,.ECICD104,.ECICD105)
+213 ;166 Get organs transplanted (max 3)
+214 IF $DATA(^SRF(ECD0,63))
SET NUM=0
FOR
SET NUM=$ORDER(^SRF(ECD0,63,NUM))
if '+NUM!($GET(ORG)'<3)
QUIT
Begin DoDot:1
+215 SET TYPE=$PIECE($GET(^SRF(ECD0,63,NUM,0)),U)
+216 IF TYPE'=""
SET ORG=+$GET(ORG)+1
SET @("ECXORG"_ORG)=$SELECT(TYPE=1:"HART",TYPE=2:"LUNG",TYPE=3:"KDNY",TYPE=4:"LIVR",TYPE=5:"PCRS",TYPE=6:"INTN",TYPE=7:"OTHR",1:"")
+217 QUIT
End DoDot:1
+218 ;
+219 ;170
IF $GET(ECXASIH)
SET ECXA="A"
+220 DO FILE^ECXSURG1
+221 ;get secondary procedures
+222 ;ecode0=s^cpt code
+223 SET ECXJ=0
+224 FOR
SET ECXJ=$ORDER(^SRO(136,ECD0,3,ECXJ))
if 'ECXJ
QUIT
IF $DATA(^(ECXJ,0))
IF $DATA(^(0))
IF $PIECE(^(0),"^")]""
Begin DoDot:1
+225 ;S ECPT=$P(^SRF(ECD0,13,ECXJ,2),U),ECXCMOD=""
+226 SET ECPT=$PIECE(^SRO(136,ECD0,3,ECXJ,0),U)
SET ECXMOD=""
+227 SET ECPT=$PIECE(^(0),"^")
SET ECXCMOD=""
+228 KILL ARR,ERR
+229 DO FIELD^DID(130.16,4,,"LABEL","ARR","ERR")
IF $DATA(ARR("LABEL"))
Begin DoDot:2
+230 KILL ARR,ERR
+231 DO FIELD^DID(130.16,4,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR")
+232 if $DATA(ERR("DIERR"))
QUIT
+233 SET SUB=$PIECE(ARR("GLOBAL SUBSCRIPT LOCATION"),";")
SET MOD=0
+234 FOR
SET MOD=$ORDER(^SRF(ECD0,13,ECXJ,SUB,MOD))
if MOD'>0
QUIT
SET ECXCMOD=ECXCMOD_$PIECE(^(MOD,0),U)_";"
End DoDot:2
+235 SET ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD)
+236 ;_ECPT
SET ECODE0="S"_U
+237 DO FILE^ECXSURG1
End DoDot:1
+238 ;get prostheses
+239 ;ecode0=i^^^^^^prosthesis^old qty field (null)
+240 SET ECXJ=0
+241 FOR
SET ECXJ=$ORDER(^SRF(ECD0,1,ECXJ))
if 'ECXJ
QUIT
IF $DATA(^(ECXJ,0))
Begin DoDot:1
+242 SET ECXP=+^SRF(ECD0,1,ECXJ,0)
SET ECXQ=$PIECE($GET(^(1)),U,2)
if 'ECXQ
SET ECXQ=1
+243 SET ECODE0="I"_U_U_U_U_U_U_ECXP_U_U
+244 DO FILE^ECXSURG1
End DoDot:1
+245 QUIT
+246 ;
+247 ;
TIME ; given date/time get increment
+1 ;A1=later, A2=earlier, TIME=difference
+2 NEW CON,TIMEDIF
+3 SET CON=$PIECE($GET(^SRF(ECD0,"CON")),U)
+4 ;
+5 ;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1)
+6 SET TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900
+7 SET TIMEDIF=$SELECT(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF)
+8 IF 'CON
Begin DoDot:1
+9 SET TIME=$JUSTIFY($TRANSLATE($JUSTIFY(TIMEDIF,4,0)," "),2,1)
+10 if TIME>"99.0"
SET TIME="99.0"
End DoDot:1
+11 IF CON
Begin DoDot:1
+12 SET TIME=$JUSTIFY(($TRANSLATE($JUSTIFY(TIMEDIF,4,0)," ")/2),2,1)
+13 if TIME>"99.5"
SET TIME="99.5"
End DoDot:1
+14 if TIME<0
SET TIME="###"
+15 QUIT
+16 ;
ANTIME ;161 Section added to determine anesthesia time
+1 NEW STDT,ENDT,SUB,NODE,VCODES
+2 SET TIME=""
+3 ;If anesthesia fields have values, determine time
IF A1&(A2)
DO TIME
QUIT
+4 ;If either anesthesia time field is null, search anes multiple
+5 SET (STDT,ENDT)=""
SET SUB=0
+6 FOR
SET SUB=$ORDER(^SRF(ECD0,50,SUB))
if '+SUB
QUIT
SET NODE=$GET(^SRF(ECD0,50,SUB,0))
Begin DoDot:1
+7 ;find earliest start date
IF $PIECE(NODE,U)
SET STDT=$SELECT(STDT="":$PIECE(NODE,U),$PIECE(NODE,U)<STDT:$PIECE(NODE,U),1:STDT)
+8 ;find latest end date
IF $PIECE(NODE,U,2)
SET ENDT=$SELECT($PIECE(NODE,U,2)>ENDT:$PIECE(NODE,U,2),1:ENDT)
End DoDot:1
+9 ;Use anes multiple dates to determine time
IF STDT&(ENDT)
SET A1=ENDT
SET A2=STDT
DO TIME
QUIT
+10 ;VA person class list
SET VCODES="^V180200^V180201^V180202^V180203^V180204^V180205^V100500^V110400^V110401^V110402^V110403^"
+11 ;If principle anesthetist or supervising anesthesiologis has one of the person classes, add two 15 minute segments to the patient's room time
IF VCODES[("^"_ECSAPC_"^")!(VCODES[("^"_ECXPAPC_"^"))
IF ECNTIME
IF ECNTIME'>97.5
SET TIME=$JUSTIFY(ECNTIME+2,2,1)
+12 ;If no calculations done, time will be returned as null
QUIT
SETUP ;Set required input for ECXTRAC
+1 SET ECHEAD="SUR"
+2 DO ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
+3 QUIT
+4 ;
