| 1 | ECXEC ;ALB/JAP,BIR/JLP,PTD-DSS Event Capture Extract [ 02/14/97 2:26 PM ] ; 12/2/04 12:35pm
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**11,8,13,24,27,33,39,46,49,71,89,92**;Dec 22, 1997;Build 30
|
|---|
| 3 | BEG ;entry point from option
|
|---|
| 4 | I '$D(^ECH) W !,"Event Capture is not initialized",!! Q
|
|---|
| 5 | D SETUP I ECFILE="" Q
|
|---|
| 6 | D ^ECXTRAC,^ECXKILL
|
|---|
| 7 | Q
|
|---|
| 8 | START ;begin EC extract
|
|---|
| 9 | N X,Y,ECDCM,ECXNPRFI
|
|---|
| 10 | S ECED=ECED+.3,ECLL=0
|
|---|
| 11 | K ^TMP("EC",$J)
|
|---|
| 12 | F S ECLL=$O(^ECH("AC1",ECLL)),ECD=ECSD-.1 Q:'ECLL D
|
|---|
| 13 | .F S ECD=$O(^ECH("AC1",ECLL,ECD)),ECDA=0 Q:(ECD>ECED)!('ECD) D
|
|---|
| 14 | ..F S ECDA=$O(^ECH("AC1",ECLL,ECD,ECDA)) Q:'ECDA D UPDATE
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | UPDATE ;sets record and updates counters
|
|---|
| 18 | S ECCH=^ECH(ECDA,0),ECL=$P(ECCH,U,4),ECXDFN=$P(ECCH,U,2)
|
|---|
| 19 | S ECXPDIV=$$RADDIV^ECXDEPT(ECL) ;Get production division from file 4
|
|---|
| 20 | S ECDT=$P(ECCH,U,3),ECM=$P(ECCH,U,6),ECC=$P(ECCH,U,8)
|
|---|
| 21 | Q:'$$PATDEM^ECXUTL2(ECXDFN,ECDT,"1;3;5;")
|
|---|
| 22 | S ECTM=$$ECXTIME^ECXUTL(ECDT),ECP=$P(ECCH,U,9)
|
|---|
| 23 | Q:ECP']""
|
|---|
| 24 | S ECO=$P(ECCH,U,12),ECV=$P(ECCH,U,10),ECDU=$P(ECCH,U,7)
|
|---|
| 25 | S ECXUNIT=$G(^ECD(ECDU,0)),ECCS=+$P(ECXUNIT,U,4),ECDCM=$P(ECXUNIT,U,5)
|
|---|
| 26 | S ECXDSSP="",ECXDSSD=$E(ECDCM,1,10),ECUSTOP=$P(ECXUNIT,U,10),ECUPCE=$P(ECXUNIT,U,14)
|
|---|
| 27 | S ICD9=$P($G(^ECH(ECDA,"P")),U,2) S:ICD9="" ICD9=" "
|
|---|
| 28 | S ECXICD9=$P($G(^ICD9(ICD9,0)),U)
|
|---|
| 29 | F I=1:1:4 S @("ECXICD9"_I)=""
|
|---|
| 30 | S (CNT,I)=0
|
|---|
| 31 | F S CNT=$O(^ECH(ECDA,"DX",CNT)) Q:'CNT D Q:I>3
|
|---|
| 32 | .S ICD9=$P($G(^ECH(ECDA,"DX",CNT,0)),U) D:ICD9'=""
|
|---|
| 33 | ..S I=I+1,@("ECXICD9"_I)=$P($G(^ICD9(ICD9,0)),U)
|
|---|
| 34 | ;derivation of dss identifier depends on whether dss unit is
|
|---|
| 35 | ;set to send data to pce
|
|---|
| 36 | S ECAC=$P($G(ECCH),U,19)
|
|---|
| 37 | ;if this is a record that 'goes to pce', then get the dss identifier
|
|---|
| 38 | ;from the clinic stop codes
|
|---|
| 39 | S (ECAC1S,ECAC2S)="000"
|
|---|
| 40 | I ECUPCE="A"!(ECUPCE="O"&(ECXA="O")) D
|
|---|
| 41 | .D:+ECAC
|
|---|
| 42 | ..S ECAC1=$P($G(^SC(+ECAC,0)),U,7),ECAC2=$P($G(^(0)),U,18)
|
|---|
| 43 | ..I 'ECAC2 S ECAC2S="000"
|
|---|
| 44 | ..I 'ECAC1 S (ECAC1S,ECAC2S)="000" Q
|
|---|
| 45 | ..S ECAC1S=$P($G(^DIC(40.7,+ECAC1,0)),U,2)
|
|---|
| 46 | ..S ECAC2S=$P($G(^DIC(40.7,+ECAC2,0)),U,2)
|
|---|
| 47 | ..S ECAC1S=$$RJ^XLFSTR(ECAC1S,3,0),ECAC2S=$$RJ^XLFSTR(ECAC2S,3,0)
|
|---|
| 48 | .S:'ECAC (ECAC1S,ECAC2S)="000"
|
|---|
| 49 | ;if this record doesn't go to pce, then get the dss identifier
|
|---|
| 50 | ;from the dss unit
|
|---|
| 51 | I ECUPCE=""!(ECUPCE="N")!(ECUPCE="O"&(ECXA="I")) D
|
|---|
| 52 | .I +ECUSTOP D
|
|---|
| 53 | ..S ECAC1S=$P($G(^DIC(40.7,+ECUSTOP,0)),U,2)
|
|---|
| 54 | ..S ECAC1S=$$RJ^XLFSTR(ECAC1S,3,0),ECAC2S="000"
|
|---|
| 55 | .I 'ECUSTOP D
|
|---|
| 56 | ..S (ECAC1S,ECAC2S)="000"
|
|---|
| 57 | S ECDSS=ECAC1S_ECAC2S
|
|---|
| 58 | I ECXLOGIC>2003 I "^18^23^24^36^41^65^94^"[("^"_ECXTS_"^") S ECDSS=$$TSMAP^ECXUTL4(ECXTS)
|
|---|
| 59 | S ECXDIV=""
|
|---|
| 60 | ;
|
|---|
| 61 | ;- Ord Div, Contrct St/End Dates, Contrct Type placeholders for FY2002
|
|---|
| 62 | S (ECXODIV,ECXCSDT,ECXCEDT,ECXCTYP)=""
|
|---|
| 63 | ;setup provider(s) as'2'_ien
|
|---|
| 64 | S (ECU1A,ECU2A,ECU3A,ECU1NPI,ECU2NPI,ECU3NPI,ECXPPC1,ECXPPC2,ECXPPC3)=""
|
|---|
| 65 | S (ECU1,ECU2,ECU3)=""
|
|---|
| 66 | K ECXPRV S ECXPROV=$$GETPRV^ECPRVMUT(ECDA,.ECXPRV) I ECXPROV Q
|
|---|
| 67 | F I=1:1:3 S Y=$O(ECXPRV("")) I Y'="" S @("ECU"_I)=+ECXPRV(Y) K ECXPRV(Y)
|
|---|
| 68 | S:$L(ECU1) ECXPPC1=$$PRVCLASS^ECXUTL(ECU1,ECDT),ECU1A="2"_$P(ECU1,";")
|
|---|
| 69 | S:$L(ECU2) ECXPPC2=$$PRVCLASS^ECXUTL(ECU2,ECDT),ECU2A="2"_$P(ECU2,";")
|
|---|
| 70 | S:$L(ECU3) ECXPPC3=$$PRVCLASS^ECXUTL(ECU3,ECDT),ECU3A="2"_$P(ECU3,";")
|
|---|
| 71 | ;change for version 2 where ECP is a variable pointer and we want to
|
|---|
| 72 | ;expand it category = category or null if stored as 0
|
|---|
| 73 | D:ECP[";"
|
|---|
| 74 | .S ECP=$S(ECP["ICPT":$P(^ICPT(+ECP,0),U)_"01",ECP<90000:$P(^EC(725,+ECP,0),U,2)_"N",1:$P(^EC(725,+ECP,0),U,2)_"L"),ECC=$S(ECC:ECC,1:"")
|
|---|
| 75 | ;pick up EC to PCE data from "P" in File 721
|
|---|
| 76 | S ECPCE=$G(^ECH(ECDA,"P")),ECPCE1=$P(ECPCE,U),ECPCE2=$P(ECPCE,U,2)
|
|---|
| 77 | S ECPCE7=$S($P(ECPCE,U,7)=1:"Y",1:"N")
|
|---|
| 78 | S ECXCMOD=""
|
|---|
| 79 | I $D(^ECH(ECDA,"MOD")) D
|
|---|
| 80 | .S MOD=0,M=""
|
|---|
| 81 | .F S MOD=$O(^ECH(ECDA,"MOD",MOD)) Q:'MOD S M=$P(^(MOD,0),U) D
|
|---|
| 82 | ..I M S ECXCMOD=ECXCMOD_M_";"
|
|---|
| 83 | .K MOD,M
|
|---|
| 84 | S:ECP?1.N ECP=$$CPT^ECXUTL3($E(ECP,1,5),"",ECV)
|
|---|
| 85 | S ECXCPT=$$CPT^ECXUTL3(ECPCE1,ECXCMOD,ECV)
|
|---|
| 86 | ;
|
|---|
| 87 | ;- Observation Patient Indicator (YES/NO)
|
|---|
| 88 | S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECDSS)
|
|---|
| 89 | ;
|
|---|
| 90 | ;- CNH status (YES/NO)
|
|---|
| 91 | S ECXCNH=$$CNHSTAT^ECXUTL4(ECXDFN)
|
|---|
| 92 | ;
|
|---|
| 93 | ;- encounter classification
|
|---|
| 94 | S (ECXAO,ECXECE,ECXHNC,ECXMIL,ECXIR)="",ECXVISIT=$P(ECCH,U,21)
|
|---|
| 95 | I ECXVISIT'="" D
|
|---|
| 96 | .D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR Q
|
|---|
| 97 | .S ECXAO=$G(ECXVIST("AO")),ECXECE=$G(ECXVIST("PGE"))
|
|---|
| 98 | .S ECXHNC=$G(ECXVIST("HNC")),ECXMIL=$G(ECXVIST("MST")),ECXIR=$G(ECXVIST("IR"))
|
|---|
| 99 | ; - Head and Neck Cancer Indicator
|
|---|
| 100 | S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN)
|
|---|
| 101 | ;
|
|---|
| 102 | ; - Get national patient record flag Indicator if exist
|
|---|
| 103 | D NPRF^ECXUTL5
|
|---|
| 104 | ;
|
|---|
| 105 | ; - If no encounter number don't file record
|
|---|
| 106 | S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECDT,ECXTS,ECXOBS,ECHEAD,ECDSS,ECCS)
|
|---|
| 107 | D:ECXENC'="" FILE
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | FILE ;file record in #727.815
|
|---|
| 111 | ;node0
|
|---|
| 112 | ;ecode=inst ECL^dfn ECXDFN^ssn ECXSSN^name ECXPNM^i/o status ECXA^day^
|
|---|
| 113 | ;DSS unit ECDU^category ECC^procedure ECP^volume ECV^
|
|---|
| 114 | ;cost center ECCS^ordering sec ECO^section ECM^
|
|---|
| 115 | ;provider ECU1A^prov per cls ECXPPC1^prov 2 ECU2A^prov#2 per cls ECXPPC2
|
|---|
| 116 | ;^prov 3 ECU3A^prov#3 per cls ECXPPC3^^mov # ECXMN^treat spec ECXTS
|
|---|
| 117 | ;^time ECTM^primary care team ECPTTM^primary care provider ECPTPR
|
|---|
| 118 | ;^pce cpt code (ECXCPT)^primary icd-9 code ECXICD9^secondary icd-9
|
|---|
| 119 | ;ECXICD91^secondary icd-9 ECXICD92^secondary icd-9 ECXICD93^secondary
|
|---|
| 120 | ;icd-9 ECXICD94^agent orange ECXAST^radiation exposure ECXRST^
|
|---|
| 121 | ;environmental contaminants ECXEST^service connected ECPTPR^sent to pce
|
|---|
| 122 | ;ECPCE7^^dss identifier ECDSS^dss dept
|
|---|
| 123 | ;node1
|
|---|
| 124 | ;mpi ECXMPI^dss dept ECXDSSD^provider npi ECXPRV2^
|
|---|
| 125 | ;provider #2 npi ECU2NPI^provider #3 npi ECU3NPI^^
|
|---|
| 126 | ;pc provider npi ECPTNPI^pc prov person class ECCLAS^
|
|---|
| 127 | ;assoc pc prov ECASPR^assoc pc prov person class ECCLAS2^
|
|---|
| 128 | ;assoc pc prov npi ECASNPI^
|
|---|
| 129 | ;divison ECXDIV^mst status ECXMST^dom ECXDOM^date of birth ECXDOB^
|
|---|
| 130 | ;enrollment category ECXCAT^ enrollment status ECXSTAT^enrollment
|
|---|
| 131 | ;priority ECXPRIOR^period of service ECXPOS^purple heart indicator
|
|---|
| 132 | ;ECXPHI^observ pat ind ECXOBS^encounter num ECXENC^
|
|---|
| 133 | ;ao loc ECXAOL^ord div ECXODIV^contr st dt ECXCSDT^
|
|---|
| 134 | ;contr end dt ECXCEDT^contr typ ECXCTYP^CNH stat ECXCNH^
|
|---|
| 135 | ;production division ECXPDIV^eligibility ECXELIG^
|
|---|
| 136 | ;head & neck cancer ind. ECXHNCI^ethnicity ECXETH^race1 ECXRAC1
|
|---|
| 137 | ;enrollment location ECXENRL^^enrollment priority
|
|---|
| 138 | ;ECXPRIOR_enrollment subgroup ECXSBGRP^user enrollee ECXUESTA^patient
|
|---|
| 139 | ;type ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date
|
|---|
| 140 | ;ECXCVEDT^enc cv eligible ECXCVENC^national patient record flag
|
|---|
| 141 | ;ECXNPRFI^emerg response indic(FEMA) ECXERI^agent orange indic ECXAO^
|
|---|
| 142 | ;environ contam ECXECE^head/neck cancer ECXHNC^encntr mst ECXMIL
|
|---|
| 143 | ;^radiation ECXIR
|
|---|
| 144 | N DA,DIK
|
|---|
| 145 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
|
|---|
| 146 | S ECODE=EC7_U_EC23_U_ECL_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
|
|---|
| 147 | S ECODE=ECODE_$$ECXDATE^ECXUTL(ECDT,ECXYM)_U_ECDU_U_ECC_U
|
|---|
| 148 | S ECODE=ECODE_ECP_U_ECV_U_ECCS_U_ECO_U_ECM_U_ECU1A_U_ECXPPC1_U
|
|---|
| 149 | S ECODE=ECODE_ECU2A_U_ECXPPC2_U_ECU3A_U_ECXPPC3_U_U_ECXMN_U
|
|---|
| 150 | S ECODE=ECODE_ECXTS_U_ECTM_U
|
|---|
| 151 | S ECODE=ECODE_ECPTTM_U_ECPTPR_U_ECXCPT_U_ECXICD9_U
|
|---|
| 152 | S ECODE=ECODE_ECXICD91_U_ECXICD92_U_ECXICD93_U
|
|---|
| 153 | S ECODE=ECODE_ECXICD94_U_ECXAST_U_ECXRST_U_ECXEST_U
|
|---|
| 154 | S ECODE=ECODE_ECSC_U_ECPCE7_U_U_ECDSS_U_U
|
|---|
| 155 | S ECODE1=ECXMPI_U_ECXDSSD_U_ECU1NPI_U_ECU2NPI_U_ECU3NPI_U_ECCLAS_U
|
|---|
| 156 | S ECODE1=ECODE1_ECPTNPI_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDIV_U
|
|---|
| 157 | S ECODE1=ECODE1_ECXMST_U_ECXDOM_U_ECXDOB_U_ECXCAT_U_ECXSTAT_U
|
|---|
| 158 | S ECODE1=ECODE1_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U_ECXOBS_U_ECXENC_U_ECXAOL_U
|
|---|
| 159 | S ECODE1=ECODE1_ECXODIV_U_ECXCSDT_U_ECXCEDT_U_ECXCTYP_U_ECXCNH_U_ECXPDIV_U
|
|---|
| 160 | S ECODE1=ECODE1_ECXELIG_U_ECXHNCI_U_ECXETH_U_ECXRC1
|
|---|
| 161 | I ECXLOGIC>2003 S ECODE1=ECODE1_U_ECXENRL_U
|
|---|
| 162 | I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U
|
|---|
| 163 | I ECXLOGIC>2004 S ECODE2=ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
|
|---|
| 164 | I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U
|
|---|
| 165 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1
|
|---|
| 166 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
|---|
| 167 | I $D(ZTQUEUED),$$S^%ZTLOAD
|
|---|
| 168 | Q
|
|---|
| 169 | ;
|
|---|
| 170 | SETUP ;Set required input for ECXTRAC
|
|---|
| 171 | S ECHEAD="ECS"
|
|---|
| 172 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 176 | D SETUP,QUE^ECXTAUTO,^ECXKILL Q
|
|---|
