| 1 | ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ; 11/2/06 9:00am | 
|---|
| 2 | ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99**;Dec 22, 1997;Build 2 | 
|---|
| 3 | BEG ;entry point from option | 
|---|
| 4 | D SETUP I ECFILE="" Q | 
|---|
| 5 | D ^ECXTRAC,^ECXKILL | 
|---|
| 6 | Q | 
|---|
| 7 | ; | 
|---|
| 8 | START ; | 
|---|
| 9 | S QFLG=0,ECED=ECED+.3,ECD=ECSD1 | 
|---|
| 10 | F  S ECD=$O(^SRF("AC",ECD)),ECD0=0 Q:('ECD)!(ECD>ECED)!(QFLG)  D | 
|---|
| 11 | .F  S ECD0=$O(^SRF("AC",ECD,ECD0)) Q:'ECD0  D | 
|---|
| 12 | ..I $D(^SRF(ECD0,0)) S EC=^SRF(ECD0,0),ECXDFN=+$P(EC,U),ECXVISIT=$P(EC,U,15) D STUFF Q:QFLG | 
|---|
| 13 | Q | 
|---|
| 14 | ; | 
|---|
| 15 | STUFF ;gather data | 
|---|
| 16 | N J,X,Y,PP,DATA1,DATA2,DATAOP,ARR,ERR,SUB,MOD,ECXNONL,ECXSTOP,TIMEDIF | 
|---|
| 17 | N ECPRO,ECXORCT,ECXPTHA,ECXNPRFI,ECXPA,ECXPAPC,ECSRPC,ECATPC,ECSAPC | 
|---|
| 18 | S ECXDATE=ECD,ECXERR=0,ECXQ="" | 
|---|
| 19 | Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;") | 
|---|
| 20 | I ECXADMDT="" S ECXADD=ECXADMDT | 
|---|
| 21 | I ECXADMDT'="" S ECXADD=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM) | 
|---|
| 22 | S EC0=^SRF(ECD0,0) | 
|---|
| 23 | S DATA1=$S($D(^SRF(ECD0,.1)):^(.1),1:"") | 
|---|
| 24 | S DATA2=$S($D(^SRF(ECD0,.2)):^(.2),1:"") | 
|---|
| 25 | ;S DATAOP=$S($D(^SRF(ECD0,"OP")):^("OP"),1:"") | 
|---|
| 26 | S DATAOP=$S($D(^SRO(136,ECD0,0)):^(0),1:"") | 
|---|
| 27 | S ECNO=$G(^SRF(ECD0,"NON")) | 
|---|
| 28 | ;get data | 
|---|
| 29 | S ECSR=$P(DATA1,U,4),(ECATNPI,ECSANPI,ECSRNPI)="",ECAT=$P(DATA1,U,13) | 
|---|
| 30 | ;-Time patient in OR room (Nurse Time) | 
|---|
| 31 | S ECXTM=$$ECXTIME^ECXUTL($P(DATA2,U,10)) | 
|---|
| 32 | S ECXDIV=$S($D(^SRF(ECD0,8)):^(8),1:ECINST) | 
|---|
| 33 | N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV)  ;Production Division | 
|---|
| 34 | S ECSA=$P($G(^SRF(ECD0,.3)),U,4),ECO=$P(EC0,U,2) | 
|---|
| 35 | ;get principle anesthetist and person class DBIA #103 | 
|---|
| 36 | S ECXPA=$P($G(^SRF(ECD0,.3)),U,1) | 
|---|
| 37 | S ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE) | 
|---|
| 38 | S ECORTY=$P($G(^SRS(+ECO,2)),U),ECO=$P($G(^SRS(+ECO,0)),U) | 
|---|
| 39 | S ECSS=$P($G(^SRO(137.45,+$P(EC0,U,4),0)),U,2) | 
|---|
| 40 | S ECSS=$$RJ^XLFSTR($P($G(^DIC(45.3,+ECSS,0)),U),3,0) | 
|---|
| 41 | S:ECSS="000" ECSS="999" | 
|---|
| 42 | ;get classification information | 
|---|
| 43 | S (ECXAO,ECXHNC)="" I ECXVISIT'="" D | 
|---|
| 44 | .D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR | 
|---|
| 45 | .S ECXAO=$G(ECXVIST("AO")),ECXHNC=$G(ECXVIST("HNC")) | 
|---|
| 46 | ; - Head and Neck Cancer Indicator | 
|---|
| 47 | S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) | 
|---|
| 48 | ;look for non-OR | 
|---|
| 49 | S (ECNT,ECNL,ECXDSSD,ECXNONL,ECXSTOP)="" | 
|---|
| 50 | I $P(ECNO,U)="Y" D | 
|---|
| 51 | .S ECSR=$P(ECNO,U,6),ECAT=$P(ECNO,U,7) | 
|---|
| 52 | .S ECXTM=$$ECXTIME^ECXUTL($P(ECNO,U,4)) | 
|---|
| 53 | .S A1=$P(ECNO,U,5),A2=$P(ECNO,U,4),TIME="##" D:(A1&A2) TIME S ECNT=TIME | 
|---|
| 54 | .S (ECXNONL,ECNL)=+$P(ECNO,U,2),ECNL=$P($G(^ECX(728.44,ECNL,0)),U,9) | 
|---|
| 55 | .S:ECNL="" ECNL="UNKNOWN" | 
|---|
| 56 | .; | 
|---|
| 57 | .;- Get DSS Stop Code to use in encounter number | 
|---|
| 58 | .S ECXSTOP=$P($G(^ECX(728.44,ECXNONL,0)),U,4) | 
|---|
| 59 | ; | 
|---|
| 60 | ;- If surgery cancelled/aborted quit and go to next record | 
|---|
| 61 | S ECCAN=$P($G(^SRF(ECD0,30)),U) | 
|---|
| 62 | I +ECCAN S ECCAN=$$CANC^ECXUTL4(ECNL,$P(DATA2,U,10)) | 
|---|
| 63 | ;on hold for ECXDSSD and ECXDSSP I $P($G(^SRF(ECD0,30)),U) Q | 
|---|
| 64 | ;get service of attending surgeon | 
|---|
| 65 | S ECATSV=$P($G(^DIC(49,+$G(^VA(200,+ECAT,5)),730)),U) | 
|---|
| 66 | ; | 
|---|
| 67 | ;get surgeon, attending and anesthesia super person classes | 
|---|
| 68 | S ECSRPC=$$PRVCLASS^ECXUTL(ECSR,ECXDATE) | 
|---|
| 69 | S ECATPC=$$PRVCLASS^ECXUTL(ECAT,ECXDATE) | 
|---|
| 70 | S ECSAPC=$$PRVCLASS^ECXUTL(ECSA,ECXDATE) | 
|---|
| 71 | ; | 
|---|
| 72 | ;add leading 2s for pointer to 200 | 
|---|
| 73 | S:ECAT ECAT="2"_ECAT S:ECSR ECSR="2"_ECSR S:ECSA ECSA="2"_ECSA | 
|---|
| 74 | ;add leading 2 to principle anesthetist IEN | 
|---|
| 75 | S:ECXPA ECXPA="2"_ECXPA | 
|---|
| 76 | ;anesthesia technique | 
|---|
| 77 | S ECANE="",PP="" | 
|---|
| 78 | I $D(^SRF(ECD0,6,0)) S ECXJ=0 D | 
|---|
| 79 | .F  S ECXJ=$O(^SRF(ECD0,6,ECXJ)) Q:('ECXJ)!(ECANE]"")  D | 
|---|
| 80 | ..S PP=$P($G(^(ECXJ,0)),U,3) S:PP="Y" ECANE=$P(^(0),U,1) | 
|---|
| 81 | .I ECANE="" S ECXJ=$O(^SRF(ECD0,6,0)) I ECXJ S ECANE=$P(^SRF(ECD0,6,ECXJ,0),U,1) | 
|---|
| 82 | ;get primary procedure | 
|---|
| 83 | ;ecode0=p^cpt code^^patient time^operation time^anesthesia time | 
|---|
| 84 | S ECPT=+$P(DATAOP,U,2),ECXCMOD="" | 
|---|
| 85 | K ARR,ERR D FIELD^DID(130,28,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D | 
|---|
| 86 | .K ARR,ERR D FIELD^DID(130,28,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR") | 
|---|
| 87 | .Q:$D(ERR("DIERR")) | 
|---|
| 88 | .S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0 | 
|---|
| 89 | .F  S MOD=$O(^SRF(ECD0,SUB,MOD)) Q:MOD'>0  D | 
|---|
| 90 | ..S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";" | 
|---|
| 91 | S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD) | 
|---|
| 92 | S ECODE0="P"_U_U  ;ECPT_U | 
|---|
| 93 | F J="10,12","2,3","1,4" D | 
|---|
| 94 | .N ECNTIME,ECSTIME,ECATIME | 
|---|
| 95 | .S A2=$P(DATA2,U,$P(J,",")),A1=$P(DATA2,U,$P(J,",",2)),TIME="##" | 
|---|
| 96 | .I (A1&A2)&(+J=10) D TIME  S ECNTIME=TIME | 
|---|
| 97 | .I (A1&A2)&(+J=1) D TIME  S ECATIME=TIME | 
|---|
| 98 | .I (A1&A2)&(+J=2) D | 
|---|
| 99 | ..; | 
|---|
| 100 | ..;-Operation Time (Surgeon Time) | 
|---|
| 101 | ..;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1) | 
|---|
| 102 | ..S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900 | 
|---|
| 103 | ..S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF) | 
|---|
| 104 | ..S TIME=$TR($J(TIMEDIF,4,0)," ") | 
|---|
| 105 | ..S:TIME<0 TIME="###" | 
|---|
| 106 | ..S:TIME ECSTIME=TIME | 
|---|
| 107 | .S ECODE0=ECODE0_U_TIME K TIME | 
|---|
| 108 | ; -Recovery Room Time | 
|---|
| 109 | S ECRR="" | 
|---|
| 110 | I $D(^SRF(ECD0,1.1)) D | 
|---|
| 111 | .S A1=$P(^(1.1),U,8),A2=$P(^(1.1),U,7),TIME="##" D:(A1&A2) TIME | 
|---|
| 112 | .S ECRR=TIME K TIME | 
|---|
| 113 | I ECNL]"" S $P(ECODE0,U,5)=ECNT | 
|---|
| 114 | ; | 
|---|
| 115 | ; -OR Clean Time in 15 min increments DBIA #103 | 
|---|
| 116 | S ECXORCT=($$FMDIFF^XLFDT($P($G(DATA2),U,14),$P($G(DATA2),U,13),2)/60)/15 | 
|---|
| 117 | ; -If no OR clean time recorded set it to 2 | 
|---|
| 118 | I ECXORCT'>0 S ECXORCT=2 | 
|---|
| 119 | ; | 
|---|
| 120 | ; -PT in hold area time in 15 min increments DBIA #103 | 
|---|
| 121 | I $P($G(DATA2),U,10),$P($G(DATA2),U,15) D | 
|---|
| 122 | .S ECXPTHA=($$FMDIFF^XLFDT($P($G(DATA2),U,10),$P($G(DATA2),U,15),2)/60)/15 | 
|---|
| 123 | .S CON=$P($G(^SRF(ECD0,"CON")),U) | 
|---|
| 124 | .I CON S ECXPTHA=ECXPTHA/2 | 
|---|
| 125 | .S ECXPTHA=$TR($J(ECXPTHA,3,0)," ") | 
|---|
| 126 | ; -If hold time is =<0 set it to "" | 
|---|
| 127 | S:$G(ECXPTHA)'>0 ECXPTHA="" | 
|---|
| 128 | ; | 
|---|
| 129 | ;- Observation Patient Indicator (yes/no) | 
|---|
| 130 | S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL) | 
|---|
| 131 | ; | 
|---|
| 132 | ;- set national patient record flag if exist | 
|---|
| 133 | D NPRF^ECXUTL5 | 
|---|
| 134 | ; | 
|---|
| 135 | ;- If no encounter number don't file record | 
|---|
| 136 | S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC="" | 
|---|
| 137 | ; | 
|---|
| 138 | D FILE | 
|---|
| 139 | ;get secondary procedures | 
|---|
| 140 | ;ecode0=s^cpt code | 
|---|
| 141 | S ECXJ=0 | 
|---|
| 142 | ;F  S ECXJ=$O(^SRF(ECD0,13,ECXJ)) Q:'ECXJ  I $D(^(ECXJ,0)),$D(^(2)),$P(^(2),U)]"" D | 
|---|
| 143 | F  S ECXJ=$O(^SRO(136,ECD0,3,ECXJ)) Q:'ECXJ  I $D(^(ECXJ,0)),$D(^(0)),$P(^(0),"^")]"" D | 
|---|
| 144 | .;S ECPT=$P(^SRF(ECD0,13,ECXJ,2),U),ECXCMOD="" | 
|---|
| 145 | . S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),"^"),ECXCMOD="" | 
|---|
| 146 | .K ARR,ERR | 
|---|
| 147 | .D FIELD^DID(130.16,4,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D | 
|---|
| 148 | ..K ARR,ERR | 
|---|
| 149 | ..D FIELD^DID(130.16,4,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR") | 
|---|
| 150 | ..Q:$D(ERR("DIERR")) | 
|---|
| 151 | ..S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0 | 
|---|
| 152 | ..F  S MOD=$O(^SRF(ECD0,13,ECXJ,SUB,MOD)) Q:MOD'>0  S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";" | 
|---|
| 153 | .S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD) | 
|---|
| 154 | .S ECODE0="S"_U   ;_ECPT | 
|---|
| 155 | .D FILE | 
|---|
| 156 | ;get prostheses | 
|---|
| 157 | ;ecode0=i^^^^^^prosthesis^old qty field (null) | 
|---|
| 158 | S ECXJ=0 | 
|---|
| 159 | F  S ECXJ=$O(^SRF(ECD0,1,ECXJ)) Q:'ECXJ  I $D(^(ECXJ,0)) D | 
|---|
| 160 | .S ECXP=+^SRF(ECD0,1,ECXJ,0),ECXQ=$P($G(^(1)),U,2) S:'ECXQ ECXQ=1 | 
|---|
| 161 | .S ECODE0="I"_U_U_U_U_U_U_ECXP_U_U | 
|---|
| 162 | .D FILE | 
|---|
| 163 | Q | 
|---|
| 164 | ; | 
|---|
| 165 | FILE ;file record | 
|---|
| 166 | ;node0 | 
|---|
| 167 | ;division^dfn^ssn^name^in/out (ECXA)^day^case #^ | 
|---|
| 168 | ;surg specialty^or room #^ | 
|---|
| 169 | ;surgeon^attending^anesthesia supervisor^anesthesia technique^ | 
|---|
| 170 | ;primary/secondary/prostheses^cpt^^pt time^op time^anes time^ | 
|---|
| 171 | ;prostheses^qty^^ | 
|---|
| 172 | ;movement number^treating specialty^cancel/abort (ECCAN)^time^or type^ | 
|---|
| 173 | ;attending's service^non-or dss id^recovery room time^^ | 
|---|
| 174 | ;primary care team^primary care provider^admission date | 
|---|
| 175 | ;node1 | 
|---|
| 176 | ;mpi^dss dept ECXDSSD^surgeon npi^attending npi^anes supervisor npi^ | 
|---|
| 177 | ;pc provider npi^pc prov person class^ | 
|---|
| 178 | ;assoc pc provider^assoc pc prov person class^assoc pc prov npi^ | 
|---|
| 179 | ;cpt&modifiers ECXCPT^dom ECXDOM^enrollment category ECXCAT^ | 
|---|
| 180 | ;enrollment status ECXSTAT^enrollment priority ECXPRIOR^ | 
|---|
| 181 | ;period of service ECXPOS^purple heart indicator ECXPHI^ | 
|---|
| 182 | ;observ pat ind ECXOBS^encounter num ECXENC^ao loc ECXAOL^ | 
|---|
| 183 | ;production division ECXPDIV^head & neck canc ind ECXHNCI^ | 
|---|
| 184 | ;ethnicity ECXETH^race1 ECXRC1^new quantity ECXQ^ | 
|---|
| 185 | ;^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig | 
|---|
| 186 | ;ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible ECXCVENC | 
|---|
| 187 | ;or clean time ECXORCT^time pt in hold area ECXPTHA^national patient | 
|---|
| 188 | ;record flag ECXNPRFI^princ anesthetist ECXPA^surgeon per class ECSRPC | 
|---|
| 189 | ;node2 | 
|---|
| 190 | ;atten surgeon per class ECATPC^anesthesia super person class ECSAPC^ | 
|---|
| 191 | ;princ anesthetist PC ECXPAPC^emergency response indicator(FEMA) ECXERI^ | 
|---|
| 192 | ;agent orange indic ECXAO^head/neck cancer ECXHNC | 
|---|
| 193 | ; | 
|---|
| 194 | N DA,DIK,STR | 
|---|
| 195 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 | 
|---|
| 196 | S ECODE=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U | 
|---|
| 197 | S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECD0_U_ECSS_U_ECO_U | 
|---|
| 198 | S ECODE=ECODE_ECSR_U_ECAT_U_ECSA_U_ECANE_U_ECODE0_U | 
|---|
| 199 | S STR=ECXMN_U_ECXTS_U_$S(ECCAN'="":ECCAN,1:"")_U_ECXTM_U_ECORTY_U | 
|---|
| 200 | S STR=STR_ECATSV_U_ECNL_U_ECRR_U_U_ECPTTM_U_ECPTPR_U_ECXADD_U | 
|---|
| 201 | S $P(ECODE,U,26,38)=STR | 
|---|
| 202 | S ECODE1=ECXMPI_U_ECXDSSD_U_ECSRNPI_U_ECATNPI_U_ECSANPI_U_ECPTNPI_U | 
|---|
| 203 | S ECODE1=ECODE1_ECCLAS_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXCPT_U_ECXDOM_U | 
|---|
| 204 | S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U | 
|---|
| 205 | S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXPDIV_U_ECXHNCI_U | 
|---|
| 206 | S ECODE1=ECODE1_ECXETH_U_ECXRC1_U_ECXQ_U | 
|---|
| 207 | I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXORCT_U_ECXPTHA_U_ECXNPRFI | 
|---|
| 208 | I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXPA_U_ECSRPC_U,ECODE2=ECATPC_U_ECSAPC_U_ECXPAPC | 
|---|
| 209 | I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXHNC | 
|---|
| 210 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1 | 
|---|
| 211 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA | 
|---|
| 212 | I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 | 
|---|
| 213 | ; | 
|---|
| 214 | TIME ; given date/time get increment | 
|---|
| 215 | ;A1=later, A2=earlier, TIME=difference | 
|---|
| 216 | N CON,TIMEDIF | 
|---|
| 217 | S CON=$P($G(^SRF(ECD0,"CON")),U) | 
|---|
| 218 | ; | 
|---|
| 219 | ;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1) | 
|---|
| 220 | S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900 | 
|---|
| 221 | S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF) | 
|---|
| 222 | I 'CON D | 
|---|
| 223 | .S TIME=$J($TR($J(TIMEDIF,4,0)," "),2,1) | 
|---|
| 224 | .S:TIME>"99.0" TIME="99.0" | 
|---|
| 225 | I CON D | 
|---|
| 226 | .S TIME=$J(($TR($J(TIMEDIF,4,0)," ")/2),2,1) | 
|---|
| 227 | .S:TIME>"99.5" TIME="99.5" | 
|---|
| 228 | S:TIME<0 TIME="###" | 
|---|
| 229 | Q | 
|---|
| 230 | ; | 
|---|
| 231 | SETUP ;Set required input for ECXTRAC | 
|---|
| 232 | S ECHEAD="SUR" | 
|---|
| 233 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) | 
|---|
| 234 | Q | 
|---|
| 235 | ; | 
|---|
| 236 | QUE ; entry point for the background requeuing handled by ECXTAUTO | 
|---|
| 237 | D SETUP,QUE^ECXTAUTO,^ECXKILL Q | 
|---|