Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUD.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• DSS_EXTRACTS-ECX/ECXUD.m (modified) (9 diffs)

FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXUD.m

@@ -1 @@
-ECXUD ;ALB/JAP,BIR/DMA,PTD-Extract from UNIT DOSE EXTRACT DATA File (#728.904) ; 10/31/07 1:58pm
- ;;3.0;DSS EXTRACTS;**10,8,24,33,39,46,49,71,84,92,107,105**;Dec 22, 1997;Build 70
+ECXUD ;ALB/JAP,BIR/DMA,PTD-Extract from UNIT DOSE EXTRACT DATA File (#728.904) ;4/19/2007
+ ;;3.0;DSS EXTRACTS;**10,8,24,33,39,46,49,71,84,92,107**;Dec 22, 1997;Build 9
 BEG ;entry point from option
  I '$O(^ECX(728.904,"A",0)) W !,"There are no unit dose orders to extract",!! R X:5 K X Q
@@ -24 +24 @@
  Q:ECXERR
  ;
- S ECXPRO=$P(DATA,U,7),ECPROIEN=+ECXPRO,ECXPRO=$E($P(ECXPRO,";",2))_$P(ECXPRO,";")
- S ECXPRNPI=$$NPI^XUSNPI("Individual_ID",ECPROIEN,ECD)
- S:+ECXPRNPI'>0 ECXPRNPI="" S ECXPRNPI=$P(ECXPRNPI,U)
- S W=$P(DATA,U,6)
+ S ECXPRO=$P(DATA,U,7),ECXPRO=$E($P(ECXPRO,";",2))_$P(ECXPRO,";")
+ S ECXPRNPI="",W=$P(DATA,U,6)
  S ECXDIV=$P($G(^DIC(42,+W,0)),U,11),ECXW=$P($G(^DIC(42,+W,44)),U)
  S ECXUDDT=$$ECXDATE^ECXUTL($P(DATA,U,3),ECXYM)
@@ -65 +63 @@
 PAT(ECXDFN,ECXDATE,ECXERR) ;get demographics from patient file
  ;init variables
- S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP,ECXOEF,ECXOEFDT)=""
+ S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP)=""
  ;get patient data if saved
  I $D(^TMP($J,"ECXP",ECXDFN)) D
@@ -78 +76 @@
  .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24)
  .S ECXETH=$P(PT,U,25),ECXRC1=$P(PT,U,26),ECXMTST=$P(PT,U,27)
- .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2),ECXOEF=$P(PT1,U,3),ECXOEFDT=$P(PT1,U,4)
+ .S PT1=$G(^TMP($J,"ECXP",ECXDFN,1)),ECXERI=$P(PT1,U),ECXEST=$P(PT1,U,2)
  .I $$ENROLLM^ECXUTL2(ECXDFN)
  ;set patient data
@@ -93 +91 @@
  .S ECXPHI=ECXPAT("PHI"),ECXMST=ECXPAT("MST STAT")
  .S ECXENRL=ECXPAT("ENROLL LOC"),ECXMTST=ECXPAT("MEANS")
- .;OEF/OIF data
- .S ECXOEF=ECXPAT("ECXOEF")
- .S ECXOEFDT=ECXPAT("ECXOEFDT")
  .;get CNHU status
  .S ECXCNHU=$$CNHSTAT^ECXUTL4(ECXDFN)
@@ -111 +106 @@
  .S ^TMP($J,"ECXP",ECXDFN)=ECXPNM_U_ECXSSN_U_ECXMPI_U_ECXDOB_U_ECXELIG_U_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST
  .S ^TMP($J,"ECXP",ECXDFN)=^TMP($J,"ECXP",ECXDFN)_U_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCNHU_U_ECXCAT_U_ECXSTAT_U_ECXPRIOR_U_ECXHNCI_U_ECXETH_U_ECXRC1_U_ECXMTST
- .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST_U_ECXOEF_U_ECXOEFDT
+ .S ^TMP($J,"ECXP",ECXDFN,1)=ECXERI_U_ECXEST
  ;
  ;get inpatient data
@@ -144 +139 @@
  ;elig ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible
  ;ECXCVENC^national patient record flag ECXNPRFI^emerg resp indic(FEMA) 
- ;ECXERI^environ contamin ECXEST^OEF/OIF ECXOEF^OEF/OIF return date ECXOEFDT^associate pc provider npi ECASNPI^primary care provider npi ECPTNPI^provider npi ECXPRNPI
+ ;ECXERI^environ contamin ECXEST
  N DA,DIK
  S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
@@ -157 +152 @@
  S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U
  S ECODE=ECODE_$$ECXTIME^ECXUTL(ECXADM)_U
- S ECODE1=ECXMPI_U_ECXDSSD_U_U_ECXDOM_U_ECXOBS_U_ECXENC_U
+ S ECODE1=ECXMPI_U_ECXDSSD_U_ECXPRNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U
  S ECODE1=ECODE1_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U_ECXSEX_U
  S ECODE1=ECODE1_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U
@@ -163 +158 @@
  S ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXCNHU_U_ECXENRL_U
  S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECPTTM_U_ECPTPR_U
- S ECODE1=ECODE1_U_ECCLAS_U_ECASPR_U_U_ECCLAS2_U
+ S ECODE1=ECODE1_ECPTNPI_U_ECCLAS_U_ECASPR_U_ECASNPI_U_ECCLAS2_U
  S ECODE2=ECXORDDT_U_ECXORDST_U_ECXHNCI_U_ECXETH_U_ECXRC1
  I ECXLOGIC>2003 S ECODE2=ECODE2_U_ECXBCDD_U_ECXBCDG_U_ECXBCUA_U_ECXBCIF_U_ECXOPPC
  I ECXLOGIC>2004 S ECODE2=ECODE2_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI
  I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXEST
- I ECXLOGIC>2007 S ECODE2=ECODE2_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_ECXPRNPI
  S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1
  S ^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1