Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXMTL.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/ECXMTL.m
r628 r636 1 ECXMTL ;ALB/JAP - DSS Mental Health Extract ; 8/17/07 9:52am2 ;;3.0;DSS EXTRACTS;**24,30,33,39,46,49,71,82,84,92 ,105**;Dec 22, 1997;Build 701 ECXMTL ;ALB/JAP - DSS Mental Health Extract ; 9/11/06 11:07am 2 ;;3.0;DSS EXTRACTS;**24,30,33,39,46,49,71,82,84,92**;Dec 22, 1997;Build 30 3 3 ; 4 4 BEG ;entry point from option … … 31 31 .S ECXSCNUM=$P(^ECX(ECFILE,JJ,0),U,23),ECXSCNAM=$P(^ECX(ECFILE,JJ,0),U,24) 32 32 .D PAT(ECXDFN,ECXDATE) 33 .S (ECXPRCLS,EC PRNPI,ECXDIV,ECXPDIV)="" I ECXPRV D PROV(.ECXPRV,ECXDATE)33 .S (ECXPRCLS,ECXPRNPI,ECXDIV,ECXPDIV)="" I ECXPRV D PROV(.ECXPRV,ECXDATE) 34 34 .S ECXDSSI="" 35 35 .I ECXLOGIC>2003 D … … 79 79 S ECXA=$P(X,U),(ECXADT,ECXADMDT)=$P($P(X,U,4),"."),ECXDCDT=$P($P(X,U,6),".") 80 80 S ECXWPRV=$P(X,U,7),ECXATT=$P(X,U,8) 81 S ECWPRNPI=$$NPI^XUSNPI("Individual_ID",ECXWPRV,ECXDATE)82 S:+ECWPRNPI'>0 ECWPRNPI="" S ECWPRNPI=$P(ECWPRNPI,U)83 S ECATTNPI=$$NPI^XUSNPI("Individual_ID",ECXATT,ECXDATE)84 S:+ECATTNPI'>0 ECATTNPI="" S ECATTNPI=$P(ECATTNPI,U)85 81 ;Get ward provider and attending phy person classes 86 82 S ECXWPRPC=$P(X,U,11),ECXATTPC=$P(X,U,12) … … 92 88 N INST,DGIEN,ARR,DIC,DR,DA,DIQ 93 89 S ECXPRCLS=$$PRVCLASS^ECXUTL(ECXPRV,ECXDATE) 94 S ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPRV,ECXDATE) 95 S:+ECPRNPI'>0 ECPRNPI="" S ECPRNPI=$P(ECPRNPI,U) 90 S ECXPRNPI="" 96 91 ;get division identifier using provider 97 92 S (ECXDIV,ECXPDIV)="" … … 119 114 ;day ECXDATE^division ECXDIV^admit date ECXADMDT^ 120 115 ;d/c date ECXDCDT^dss id ECXDSSI^pc team ECPTTM^pc provider ECPTPR^ 121 ;p laceholder^pc prov person class ECCLAS^122 ;provider ECXPRV^p laceholder^prov person class ECXPRCLS^116 ;pc provider npi ECPTNPI^pc prov person class ECCLAS^ 117 ;provider ECXPRV^provider npi ECXPRNPI^prov person class ECXPRCLS^ 123 118 ;test name ECXSCNAM(?)^test ien ECXSCNUM(?)^scale number^scale name^ 124 119 ;test score^scale score^attend phys^ward provider 125 120 ;node1 126 ;mpi^assoc pc provider^ placeholder^121 ;mpi^assoc pc provider^assoc pc provider npi^ 127 122 ;assoc pc prov person class^asi class^asi special^asi encounter date^ 128 123 ;purple heart ind.^dom prrtp & saartp ind.^enrollment cat^ … … 135 130 ;enc cv eligible ECXCVENC^national patient record flag ECXNPRFI 136 131 ;attending phy person class ECXATTPC^ward provider person class 137 ;ECXWPRPC^^agent orange status ECXAST^asso prov npi ECASNPI^att phy 138 ;npi ECATTNPI^primary care prov npi ECPTNPI^provider npi ECPRNPI^ward 139 ;provider npi ECWPRNPI 132 ;ECXWPRPC^^agent orange status ECXAST 140 133 N DA,DIK,STR 141 134 I $P(^ECX(ECFILE,JJ,0),U,21)="ASI" S $P(^ECX(ECFILE,JJ,1),U,7)=ECXDATE 142 135 S $P(^ECX(ECFILE,JJ,0),U,6,9)=ECXSSN_U_ECXPNM_U_ECXA_U_ECXDATE 143 136 S STR=$S(ECXLOGIC<2005:ECXDIV,1:"")_U_ECXADMDT_U_ECXDCDT_U_ECXDSSI_U_ECPTTM_U_ECPTPR_U 144 S STR=STR_ U_ECCLAS,$P(^ECX(ECFILE,JJ,0),U,10,17)=STR,STR=""145 S $P(^ECX(ECFILE,JJ,0),U,18,20)=ECXPRV_U_ U_ECXPRCLS137 S STR=STR_ECPTNPI_U_ECCLAS,$P(^ECX(ECFILE,JJ,0),U,10,17)=STR,STR="" 138 S $P(^ECX(ECFILE,JJ,0),U,18,20)=ECXPRV_U_ECXPRNPI_U_ECXPRCLS 146 139 S $P(^ECX(ECFILE,JJ,0),U,23,24)=ECXSCNUM_U_ECXSCNAM 147 140 S $P(^ECX(ECFILE,JJ,0),U,27,29)=ECXATT_U_ECXWPRV_U 148 141 I '$D(^ECX(ECFILE,JJ,1)) S ^ECX(727.812,JJ,1)="^^^^^" 149 S $P(^ECX(ECFILE,JJ,1),U,1,4)=ECXMPI_U_ECASPR_U_ U_ECCLAS2142 S $P(^ECX(ECFILE,JJ,1),U,1,4)=ECXMPI_U_ECASPR_U_ECASNPI_U_ECCLAS2 150 143 S STR=ECXPHI_U_ECXDOM_U_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U 151 144 S STR=STR_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXDOB_U_ECXPDIV_U_ECXDEPT_U … … 154 147 I ECXLOGIC>2005 S STR=STR_U_ECXATTPC_U_ECXWPRPC 155 148 S $P(^ECX(ECFILE,JJ,1),U,8,22)=STR 156 I ECXLOGIC>2006 S $P(^ECX(ECFILE,JJ,1),U,34)=ECXAST_U 157 I ECXLOGIC>2007 S $P(^ECX(ECFILE,JJ,1),U,35)=ECASNPI_U_ECATTNPI_U_ECPTNPI_U D 158 . S ^ECX(ECFILE,JJ,2)=ECPRNPI_U_ECWPRNPI 149 I ECXLOGIC>2006 S $P(^ECX(ECFILE,JJ,1),U,34)=ECXAST 159 150 S DA=JJ,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 160 151 S ECRN=ECRN+1
Note:
See TracChangeset
for help on using the changeset viewer.