Changeset 636 for FOIAVistA/tag/r/DSS_EXTRACTS-ECX/ECXRAD.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/ECXRAD.m (modified) (5 diffs)

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

@@ -1 @@
-ECXRAD ;ALB/JAP,BIR/PDW,PTD-Extract for Radiology ; 5/30/2007
- ;;3.0;DSS EXTRACTS;**11,8,13,16,24,33,39,46,71,84,92,105**;Dec 22, 1997;Build 70
+ECXRAD ;ALB/JAP,BIR/PDW,PTD-Extract for Radiology ; 6/23/06 6:52am
+ ;;3.0;DSS EXTRACTS;**11,8,13,16,24,33,39,46,71,84,92**;Dec 22, 1997;Build 30
 BEG ;entry point from option
  D SETUP I ECFILE="" Q
@@ -17 +17 @@
  ;
 GET ;get data
- N ECXIEN,X,SUB,TYPE,ECDOCPC,ECXIS,ECXISPC,ECXPRCL,ECXCSC,ECXUSRTN
+ N ECXIEN,X,SUB,TYPE,ECDOCPC,ECXIS,ECXISPC,ECXPRCL,ECXCSC
  S ^TMP("ECL",$J,ECXDFN)=""
  ;with dfn get all exams within date range
@@ -60 +60 @@
  ...S ECXW=$P(ECCA,U,6),ECXW=$P($G(^DIC(42,+ECXW,44)),U)
  ...S:ECXW="" ECXW=$P(ECCA,U,8)
- ...S ECDOCNPI=$$NPI^XUSNPI("Individual_ID",$P(ECCA,U,14),ECDT)
- ...S:+ECDOCNPI'>0 ECDOCNPI="" S ECDOCNPI=$P(ECDOCNPI,U)
  ...S (ECXDSSD,ECXDSSP)=""
- ...S ECS=$P(ECCA,U,7),ECDOC=ECPROF_$P(ECCA,U,14),ECDI=$P(ECCA,U,13),ECDOCPC=$$PRVCLASS^ECXUTL($P(ECCA,U,14),ECDT)
+ ...S ECS=$P(ECCA,U,7),ECDOC=ECPROF_$P(ECCA,U,14),ECDOCNPI="",ECDI=$P(ECCA,U,13),ECDOCPC=$$PRVCLASS^ECXUTL($P(ECCA,U,14),ECDT)
  ...S ECPRO=$P(ECCA,U,2),ECSTAT=$P($G(^RA(72,+$P(ECCA,U,3),0)),U,3)
  ...;get the primary interpreting staff and the person class DBIA #65
  ...S ECXIS=$P(ECCA,U,15),ECXISPC=$$PRVCLASS^ECXUTL(ECXIS,ECDT)
- ...S ECISNPI=$$NPI^XUSNPI("Individual_ID",ECXIS,ECDT)
- ...S:+ECISNPI'>0 ECISNPI="" S ECISNPI=$P(ECISNPI,U)
  ...;prefix interpreting radiologist with a "2" if not null
  ...S ECXIS=$S(ECXIS:"2"_ECXIS,1:"")
@@ -104 +100 @@
  ;imaging type^primary care team^primary care provider
  ;node1
- ;mpi^dss dept^placeholder^placeholder^pc prov person class^
- ;assoc pc provider^assoc pc prov person class^placeholder^dom^
+ ;mpi^dss dept^req physician npi^pc provider npi^pc prov person class^
+ ;assoc pc provider^assoc pc prov person class^assoc pc prov npi^dom^
  ;observ pat ind^encounter num^ord stop code^ord date^division^
  ;dss product ECXDSSP^requesting provider person class ECDOCPC^interp-
  ;reting radiologist ECXIS^interpreting radiologist pc ECXISPC^princi-
  ;pal clinic ECXPRCL^clinc stop code ECXCSC^emergency response indicator
- ;(FEMA) ECXERI^assoc pc provider npi^interpreting rad npi^pc provider npi^req physician npi
+ ;(FEMA) ECXERI
  N DA,DIK
  S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
@@ -117 +113 @@
  S ECODE=ECODE_ECDOC_U_ECMODS_U_ECXMN_U_ECXTS_U_ECTM_U_ECTY_U_ECPTTM_U
  S ECODE=ECODE_ECPTPR_U
- S ECODE1=ECXMPI_U_ECXDSSD_U_U_U_ECCLAS_U_ECASPR_U
- S ECODE1=ECODE1_ECCLAS2_U_U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXORDST_U
+ S ECODE1=ECXMPI_U_ECXDSSD_U_ECDOCNPI_U_ECPTNPI_U_ECCLAS_U_ECASPR_U
+ S ECODE1=ECODE1_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXORDST_U
  S ECODE1=ECODE1_ECXORDDT_U_ECXPDIV_U
  I ECXLOGIC>2004 S ECODE1=ECODE1_ECXDSSP_U_ECDOCPC
  I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXIS_U_ECXISPC_U_ECXPRCL_U_ECXCSC
  I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI
- I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECASNPI_U_ECISNPI_U_ECPTNPI_U_ECDOCNPI
  S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1
  S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA