Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXQSR.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXQSR.m
r628 r636 1 ECXQSR ;ALB/JAP,BIR/PTD-DSS QUASAR Extract ; 7/31/07 11:19pm2 ;;3.0;DSS EXTRACTS;**11,8,13,26,24,34,33,35,39,43,46,49,64,71,84,92,106 ,105**;Dec 22, 1997;Build 701 ECXQSR ;ALB/JAP,BIR/PTD-DSS QUASAR Extract ; 04/16/07 8:58am 2 ;;3.0;DSS EXTRACTS;**11,8,13,26,24,34,33,35,39,43,46,49,64,71,84,92,106**;Dec 22, 1997;Build 1 3 3 BEG ;entry point from option 4 4 I '$O(^ACK(509850.8,0)) W !,"You must be using the Quality Audiology & Speech Pathology",!,"Audit & Review (QUASAR) software to run this extract.",!! Q … … 35 35 S ECXDFN=$P(ECZNODE,U,2) 36 36 Q:'$$PATDEM^ECXUTL2(ECXDFN,ECD,"1;3;5") 37 S OK=$$PAT^ECXUTL3(ECXDFN,ECDT,"1;5",.ECXPAT)38 I 'OK S ECXERR=1 K ECXPAT Q39 ;OEF/OIF data40 S ECXOEF=ECXPAT("ECXOEF")41 S ECXOEFDT=ECXPAT("ECXOEFDT")42 ;43 37 S ECHL="",ECXDIV=$P($G(^ACK(509850.6,ECDA,5)),U),ECSTOP=$P(EC2NODE,U) 44 38 S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV) ; Get Production Division … … 63 57 I +ECXQV=2 D 64 58 .S ECXPRV1=$P(EC2NODE,U,7),ECXPRV2=$P(EC2NODE,U,3),ECXPRV3=$P(EC2NODE,U,5),ECPN=0 65 .S ECPR1NPI=$$NPI^XUSNPI("Individual_ID",ECXPRV1,ECD)66 .S:+ECPR1NPI'>0 ECPR1NPI="" S ECPR1NPI=$P(ECPR1NPI,U)67 .S ECPR2NPI=$$NPI^XUSNPI("Individual_ID",ECXPRV2,ECD)68 .S:+ECPR2NPI'>0 ECPR2NPI="" S ECPR2NPI=$P(ECPR2NPI,U)69 .S ECPR3NPI=$$NPI^XUSNPI("Individual_ID",ECXPRV3,ECD)70 .S:+ECPR3NPI'>0 ECPR3NPI="" S ECPR3NPI=$P(ECPR3NPI,U)71 59 .F S ECPN=$O(^ACK(509850.6,ECDA,3,ECPN)) Q:'ECPN D 72 60 ..S XX=^ACK(509850.6,ECDA,3,ECPN,0),XX=$P(XX,U),XX=$P($G(^ACK(509850.4,XX,0)),U),ECXCPT=$E($$CPT^ECXUTL3(XX),1,5) … … 140 128 .S:ECXPRV1'="" ECXPPC1=$$PRVCLASS^ECXUTL(ECXPRV1,ECD),ECXPRV1=2_ECXPRV1 141 129 .S ECP=$P(LOC(CPT),U,3) I ECP="" S ECP=$$CPT^ECXUTL3(CPT,"",ECV) 142 .D FILE ^ECXQSR1130 .D FILE 143 131 K CPT,LOC 132 Q 133 FILE ;file record in #727.825 134 ;node0 135 ;inst^dfn ECXDFN^ssn ECXSSN^name ECXPNM^i/o status ECXA^day ECDAY^ 136 ;DSS unit ECDU^^category ECPTTM^procedure ECP^volume ECV^cost center^ 137 ;ordering sec ^section^provider ECXPRV1^ECXPPC1^ECXPRV2^ECXPPC2^ECXPRV3^ 138 ;ECXPPC3^mov # ECXMN^treat spec ECXTS^time ECTIME^primary care team 139 ;ECPTTM^primary care provider ECPTPR^pce cpt code & modifers ECXCPT^ 140 ;primary icd-9 code ECDIA^secondary icd-9 #1 ECXICD91^secondary icd-9 141 ;#2 ECXICD92^secondary icd-9 #3 ECXICD93^secondary icd-9 #4 ECXICD94^ 142 ;agent orange ECXAST^radiation exposure ECRST^environmental 143 ;contaminants ECEST^service connected ECSC^sent to pce^^dss identifier 144 ;ECDSS^placeholder 145 ;node1 146 ;mpi ECXNPI^dss dept ECXDSSD^provider npi ECUN1NPI^^^pc prov person 147 ;class ECPTNPI^assoc pc provider ECASPR^assoc pc prov person class 148 ;ECCLAS2^assoc pc provider npi ECASNPI^divison ECXDIV^dom ECXDOM^ 149 ;enrollment category ECXCAT^enrollment status ECXSTAT^enrollment prior 150 ;ECXPRIOR^period of service ECXPOS^purple heart ECXPHI^observ pat ind 151 ;ECXOBS^encounter num ECXENC^ao loc ECXAOL^ord div ECXODIV^contr st dt 152 ;ECXCSDT^contr end dt ECXCEDT^contr typ ECXCTYP^CNH stat ECXCNH^ 153 ;production division ECXPDIV^eligibility ECXELIG^ethnicity ECXETH^ 154 ;race1 ECXRC1^enrollment location ECXENRL^^enrollment priority 155 ;ECXPRIOR_enrollment subgroup ECXSBGRP^user enrollee ECXUESTA^patient 156 ;type ECXPTYPE^combat vet elig ECXCVE^combat vet elig end date ECXCVEDT^ 157 ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI^ 158 ;emergency response indicator(FEMA) ECXERI^agent orange indicator 159 ;ECXAO^environ contam ECXECE^head/neck ECXHNC^military sexual trauma 160 ;ECXMIL^radiation encoun ECXIR^nutrition dx 161 N DA,DIK 162 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 163 S ECODE=EC7_U_EC23_U 164 S ECODE=ECODE_ECL_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U_ECDAY_U_ECDU_U_U 165 S ECODE=ECODE_ECP_U_ECV_U_ECCS_U_ECO_U_ECM_U_ECXPRV1_U_ECXPPC1_U 166 S ECODE=ECODE_ECXPRV2_U_ECXPPC2_U_ECXPRV3_U_ECXPPC3_U_U 167 S ECODE=ECODE_ECXMN_U_ECXTS_U_ECTIME_U_ECPTTM_U 168 S ECODE=ECODE_ECPTPR_U_ECXCPT_U_ECDIA_U_ECXICD91_U_ECXICD92_U 169 S ECODE=ECODE_ECXICD93_U_ECXICD94_U_ECXAST_U_ECXRST_U_ECXEST_U 170 S ECODE=ECODE_ECSC_U_"N"_U_U_ECDSS_U_U 171 S ECODE1=ECXMPI_U_ECXDSSD_U_ECUN1NPI_U_U_U_ECCLAS_U_ECPTNPI_U_ECASPR_U 172 S ECODE1=ECODE1_ECCLAS2_U_ECASNPI_U_ECXDIV_U_ECXMST_U_ECXDOM_U 173 S ECODE1=ECODE1_ECXDOB_U_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U 174 S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXODIV_U_ECXCSDT_U_ECXCEDT_U 175 S ECODE1=ECODE1_ECXCTYP_U_ECXCNH_U_ECXPDIV_U_ECXELIG_U_ECXHNCI_U_ECXETH_U 176 S ECODE1=ECODE1_ECXRC1 177 I ECXLOGIC>2003 S ECODE1=ECODE1_U_ECXENRL 178 I ECXLOGIC>2004 S ECODE1=ECODE1_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U 179 I ECXLOGIC>2004 S ECODE2=ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 180 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXECE_U_ECXHNC_U_ECXMIL_U_ECXIR_U 181 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=$G(ECODE2),ECRN=ECRN+1 182 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 183 I $D(ZTQUEUED),$$S^%ZTLOAD 144 184 Q 145 185 SETUP ;Set required input for ECXTRAC
Note:
See TracChangeset
for help on using the changeset viewer.