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

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

@@ -1 @@
-ECXLABN ;ALB/JAP,BIR/CML-Lab Extract for DSS (New Format - With LMIP Codes) ; 10/23/07 3:01pm
- ;;3.0;DSS EXTRACTS;**1,11,8,13,28,24,30,31,32,33,39,42,46,70,71,80,92,107,105**;Dec 22, 1997;Build 70
+ECXLABN ;ALB/JAP,BIR/CML-Lab Extract for DSS (New Format - With LMIP Codes) ; 4/25/07 8:52am
+ ;;3.0;DSS EXTRACTS;**1,11,8,13,28,24,30,31,32,33,39,42,46,70,71,80,92,107**;Dec 22, 1997;Build 9
 BEG ;entry point
  D SETUP I ECFILE="" Q
@@ -22 +22 @@
  F  S ECLRN=$O(^LRO(64.03,ECLRN)) Q:'ECLRN  D  Q:QFLG
  .Q:'$D(^LRO(64.03,ECLRN,0))
- .S EC1=^LRO(64.03,ECLRN,0),ECDOC=ECPROF_$P(EC1,U,2)
- .S ECDOCNPI=$$NPI^XUSNPI("Individual_ID",$P(EC1,U,2),$P(EC1,U,4))
- .S:+ECDOCNPI'>0 ECDOCNPI="" S ECDOCNPI=$P(ECDOCNPI,U)
+ .S EC1=^LRO(64.03,ECLRN,0),ECDOC=ECPROF_$P(EC1,U,2),ECDOCNPI=""
  .S ECLOC=$P(EC1,U,15),EC=$P(EC1,U,3),ECDOCPC=$$PRVCLASS^ECXUTL($P(EC1,U,2),$P(EC1,U,4))
  .I EC]"" D GET
@@ -32 +30 @@
  ;
 GET ;get data
- N X,ECXSTN,QFLAG
+ N X,ECXSTN
  S ECF=$S($P(EC,";",2)="DPT(":2,$P(EC,";",2)="LRT(67,":67,1:0) Q:'ECF
- S ECIFN=$P(EC,";"),QFLAG=0
+ S ECIFN=$P(EC,";")
  ;resolve ecloc
  S ECXL1=+$P(ECLOC,";",1),ECXL2=$P(ECLOC,";",2)
@@ -51 +49 @@
  Q:ECXERR
  ;get patient data if record is in file #67
- I ECF=67 S ECSN="000123456",ECNA="RFRL" I $D(^LRT(67,ECIFN,0)) D  Q:QFLAG
+ I ECF=67 S ECSN="000123456",ECNA="RFRL" I $D(^LRT(67,ECIFN,0)) D
  .S ECXMPI="",EC0=^LRT(67,ECIFN,0),ECNA=$E($P($P(EC0,U),",")_"    ",1,4)
  .S ECSN=$P(EC0,U,9),ECXERI="" D
@@ -60 +58 @@
  ..I $L(ECSN)=9,ECSN'?9N S ECSN="000123456" Q
  ..I $L(ECSN)=10,ECSN'?9N1"P" S ECSN="000123456"
- ..I '$$SSN^ECXUTL5(ECSN,ECF) S QFLAG=1
  ;
  ;- Only set treating spec (TS) to TS in file #64.03 if it does not exist
@@ -120 +117 @@
  ;ord stop code ECXORDST^ord date ECXORDDT^production division
  ;ECXPDIV^^ordering provider person class^emergency response indicator
- ;(FEMA) ECXERI^associate pc provider npi ECASNPI^primary care provider
- ;npi ECPTNPI^provider npi ECDOCNPI
+ ;(FEMA) ECXERI
  ;ECDOCPC
  N DA,DIK
@@ -135 +131 @@
  S ECODE=ECODE_ECPTTM_U_ECPTPR_U
  ;(ECACA=acc area^abbreviation)
- S ECODE1=ECXMPI_U_ECXDSSD_U_U_U_ECCLAS_U_ECASPR_U
- S ECODE1=ECODE1_ECCLAS2_U_U_ECXDOM_U_ECXOBS_U_ECXENC_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
  S ECODE1=ECODE1_ECXORDST_U_ECXORDDT_U_ECXPDIV_U
  I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECDOCPC
  I ECXLOGIC>2006 S ECODE1=ECODE1_U_ECXERI
- I ECXLOGIC>2007 S ECODE1=ECODE1_U_ECASNPI_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