Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXEC.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXEC.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXEC.m
r613 r623 1 ECXEC ;ALB/JAP,BIR/JLP,PTD-DSS Event Capture Extract ; 10/2/07 2:33pm 2 ;;3.0;DSS EXTRACTS;**11,8,13,24,27,33,39,46,49,71,89,92,105**;Dec 22, 1997;Build 70 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 ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECU1,ECDT) 70 S:+ECXUSRTN'>0 ECXUSRTN="" S ECU1NPI=$P(ECXUSRTN,U) 71 S:$L(ECU2) ECXPPC2=$$PRVCLASS^ECXUTL(ECU2,ECDT),ECU2A="2"_$P(ECU2,";") 72 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECU2,ECDT) 73 S:+ECXUSRTN'>0 ECXUSRTN="" S ECU2NPI=$P(ECXUSRTN,U) 74 S:$L(ECU3) ECXPPC3=$$PRVCLASS^ECXUTL(ECU3,ECDT),ECU3A="2"_$P(ECU3,";") 75 S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",ECU3,ECDT) 76 S:+ECXUSRTN'>0 ECXUSRTN="" S ECU3NPI=$P(ECXUSRTN,U) 77 ;change for version 2 where ECP is a variable pointer and we want to 78 ;expand it category = category or null if stored as 0 79 D:ECP[";" 80 .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:"") 81 ;pick up EC to PCE data from "P" in File 721 82 S ECPCE=$G(^ECH(ECDA,"P")),ECPCE1=$P(ECPCE,U),ECPCE2=$P(ECPCE,U,2) 83 S ECPCE7=$S($P(ECPCE,U,7)=1:"Y",1:"N") 84 S ECXCMOD="" 85 I $D(^ECH(ECDA,"MOD")) D 86 .S MOD=0,M="" 87 .F S MOD=$O(^ECH(ECDA,"MOD",MOD)) Q:'MOD S M=$P(^(MOD,0),U) D 88 ..I M S ECXCMOD=ECXCMOD_M_";" 89 .K MOD,M 90 S:ECP?1.N ECP=$$CPT^ECXUTL3($E(ECP,1,5),"",ECV) 91 S ECXCPT=$$CPT^ECXUTL3(ECPCE1,ECXCMOD,ECV) 92 ; 93 ;- Observation Patient Indicator (YES/NO) 94 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECDSS) 95 ; 96 ;- CNH status (YES/NO) 97 S ECXCNH=$$CNHSTAT^ECXUTL4(ECXDFN) 98 ; 99 ;- encounter classification 100 S (ECXAO,ECXECE,ECXHNC,ECXMIL,ECXIR)="",ECXVISIT=$P(ECCH,U,21) 101 I ECXVISIT'="" D 102 .D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR Q 103 .S ECXAO=$G(ECXVIST("AO")),ECXECE=$G(ECXVIST("PGE")) 104 .S ECXHNC=$G(ECXVIST("HNC")),ECXMIL=$G(ECXVIST("MST")),ECXIR=$G(ECXVIST("IR")) 105 ; - Head and Neck Cancer Indicator 106 S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) 107 ; 108 ; - Get national patient record flag Indicator if exist 109 D NPRF^ECXUTL5 110 ; 111 ; - If no encounter number don't file record 112 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECDT,ECXTS,ECXOBS,ECHEAD,ECDSS,ECCS) 113 D:ECXENC'="" FILE 114 Q 115 ; 116 FILE ;file record in #727.815 117 ;node0 118 ;ecode=inst ECL^dfn ECXDFN^ssn ECXSSN^name ECXPNM^i/o status ECXA^day^ 119 ;DSS unit ECDU^category ECC^procedure ECP^volume ECV^ 120 ;cost center ECCS^ordering sec ECO^section ECM^ 121 ;provider ECU1A^prov per cls ECXPPC1^prov 2 ECU2A^prov#2 per cls ECXPPC2 122 ;^prov 3 ECU3A^prov#3 per cls ECXPPC3^^mov # ECXMN^treat spec ECXTS 123 ;^time ECTM^primary care team ECPTTM^primary care provider ECPTPR 124 ;^pce cpt code (ECXCPT)^primary icd-9 code ECXICD9^secondary icd-9 125 ;ECXICD91^secondary icd-9 ECXICD92^secondary icd-9 ECXICD93^secondary 126 ;icd-9 ECXICD94^agent orange ECXAST^radiation exposure ECXRST^ 127 ;environmental contaminants ECXEST^service connected ECPTPR^sent to pce 128 ;ECPCE7^^dss identifier ECDSS^dss dept 129 ;node1 130 ;mpi ECXMPI^dss dept ECXDSSD^PLACEHOLDER 131 ;placeholder^placeholder^placeholder^ 132 ;placeholder^pc prov person class ECCLAS^ 133 ;assoc pc prov ECASPR^assoc pc prov person class ECCLAS2^ 134 ;placeholder^ 135 ;divison ECXDIV^mst status ECXMST^dom ECXDOM^date of birth ECXDOB^ 136 ;enrollment category ECXCAT^ enrollment status ECXSTAT^enrollment 137 ;priority ECXPRIOR^period of service ECXPOS^purple heart indicator 138 ;ECXPHI^observ pat ind ECXOBS^encounter num ECXENC^ 139 ;ao loc ECXAOL^ord div ECXODIV^contr st dt ECXCSDT^ 140 ;contr end dt ECXCEDT^contr typ ECXCTYP^CNH stat ECXCNH^ 141 ;production division ECXPDIV^eligibility ECXELIG^ 142 ;head & neck cancer ind. ECXHNCI^ethnicity ECXETH^race1 ECXRAC1 143 ;enrollment location ECXENRL^^enrollment priority 144 ;ECXPRIOR_enrollment subgroup ECXSBGRP^user enrollee ECXUESTA^patient 145 ;type ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date 146 ;ECXCVEDT^enc cv eligible ECXCVENC^national patient record flag 147 ;ECXNPRFI^emerg response indic(FEMA) ECXERI^agent orange indic ECXAO^ 148 ;environ contam ECXECE^head/neck cancer ECXHNC^encntr mst ECXMIL 149 ;^radiation ECXIR^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT 150 ;^associate pc provider npi ECASNPI^primary care provider npi ECPTNPI^ 151 ;provider npi ECU1NPI^provider #2 ECU2NPI^provider #3 ECU3NPI 152 N DA,DIK 153 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 154 S ECODE=EC7_U_EC23_U_ECL_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U 155 S ECODE=ECODE_$$ECXDATE^ECXUTL(ECDT,ECXYM)_U_ECDU_U_ECC_U 156 S ECODE=ECODE_ECP_U_ECV_U_ECCS_U_ECO_U_ECM_U_ECU1A_U_ECXPPC1_U 157 S ECODE=ECODE_ECU2A_U_ECXPPC2_U_ECU3A_U_ECXPPC3_U_U_ECXMN_U 158 S ECODE=ECODE_ECXTS_U_ECTM_U 159 S ECODE=ECODE_ECPTTM_U_ECPTPR_U_ECXCPT_U_ECXICD9_U 160 S ECODE=ECODE_ECXICD91_U_ECXICD92_U_ECXICD93_U 161 S ECODE=ECODE_ECXICD94_U_ECXAST_U_ECXRST_U_ECXEST_U 162 S ECODE=ECODE_ECSC_U_ECPCE7_U_U_ECDSS_U_U 163 S ECODE1=ECXMPI_U_ECXDSSD_U_U_U_U_ECCLAS_U 164 S ECODE1=ECODE1_U_ECASPR_U_ECCLAS2_U_U_ECXDIV_U 165 S ECODE1=ECODE1_ECXMST_U_ECXDOM_U_ECXDOB_U_ECXCAT_U_ECXSTAT_U 166 S ECODE1=ECODE1_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U_ECXOBS_U_ECXENC_U_ECXAOL_U 167 S ECODE1=ECODE1_ECXODIV_U_ECXCSDT_U_ECXCEDT_U_ECXCTYP_U_ECXCNH_U_ECXPDIV_U 168 S ECODE1=ECODE1_ECXELIG_U_ECXHNCI_U_ECXETH_U_ECXRC1 169 I ECXLOGIC>2003 S ECODE1=ECODE1_U_ECXENRL_U 170 I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U 171 I ECXLOGIC>2004 S ECODE2=ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 172 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U 173 I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECU1NPI_U_ECU2NPI_U_ECU3NPI 174 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1 175 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 176 I $D(ZTQUEUED),$$S^%ZTLOAD 177 Q 178 ; 179 SETUP ;Set required input for ECXTRAC 180 S ECHEAD="ECS" 181 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 182 Q 183 ; 184 QUE ; entry point for the background requeuing handled by ECXTAUTO 185 D SETUP,QUE^ECXTAUTO,^ECXKILL Q 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
Note:
See TracChangeset
for help on using the changeset viewer.
