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

Timestamp:

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

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

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

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

@@ -1 @@
-ECXPIVDN ;ALB/JAP,BIR/DMA,CML,PTD-Extract from IV EXTRACT DATA File (#728.113) ; 10/31/07 1:38pm
- ;;3.0;DSS EXTRACTS;**10,11,8,13,24,33,39,46,49,71,84,96,92,107,105**;Dec 22, 1997;Build 70
-BEG ;entry point from option
- D SETUP I ECFILE="" Q
- D ^ECXTRAC,^ECXKILL
- Q
- ;
+ECXPIVDN ;ALB/JAP,BIR/DMA,CML,PTD-Extract from IV EXTRACT DATA File (#728.113) ; 4/19/2007
+ ;;3.0;DSS EXTRACTS;**10,11,8,13,24,33,39,46,49,71,84,96,92,107**;Dec 22, 1997;Build 9
 START ; start package specific extract
  N DIC,DA,DR,DIQ,DFN,ECXNPRFI,ECXPHA
@@ -58 +53 @@
  I $L(ECNFC)=12 S ECNFC=$$RJ^XLFSTR(P1,4,0)_$$RJ^XLFSTR(P3,3,0)_ECNFC
  ;- Ordering provider ("2"_provider)
- S ECXORDPR=$S(+$P(EC,U,10):"2"_$P(EC,U,10),1:"")
- N ECXUSRTN
- S ECXUSRTN=$$NPI^XUSNPI("Individual_ID",$P(EC,U,10),$P(EC,U,16))
- S:+ECXUSRTN'>0 ECXUSRTN="" S ECXOPNPI=$P(ECXUSRTN,U)
+ S ECXORDPR=$S(+$P(EC,U,10):"2"_$P(EC,U,10),1:""),ECXOPNPI=""
  S ECXORDDT=$P(EC,U,16) ;- Ordering date
  ;- Requesting physician (null for FY2002)
@@ -83 +75 @@
  ;set national patient record flag if exist
  S ECXDFN=DFN D NPRF^ECXUTL5 K ECXDFN
- D:ECXENC'="" FILE^ECXPIVD2 K P1,P3
+ D:ECXENC'="" FILE K P1,P3
  Q
 PAT(ECXDFN,ECXDATE,ECXERR) ;get patient demographics, primary care, and inpatient data
  N X
- S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP,ECXOEF,ECXOEFDT)=""
+ S (ECXCAT,ECXSTAT,ECXPRIOR,ECXSBGRP)=""
  ;get patient data if saved
  I $D(^TMP($J,"ECXP",ECXDFN)) D
@@ -95 +87 @@
  .S ECXAOL=$P(PT,U,16),ECXPHI=$P(PT,U,17),ECXMST=$P(PT,U,18),ECXENRL=$P(PT,U,19),ECXCNHU=$P(PT,U,20),ECXCAT=$P(PT,U,21)
  .S ECXSTAT=$P(PT,U,22),ECXPRIOR=$P(PT,U,23),ECXHNCI=$P(PT,U,24),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
@@ -113 +105 @@
  .S ECXETH=ECXPAT("ETHNIC"),ECXRC1=ECXPAT("RACE1")
  .S ECXERI=ECXPAT("ERI") ;emergency response indicator (FEMA)
- .S ECXOEF=ECXPAT("ECXOEF")
- .S ECXOEFDT=ECXPAT("ECXOEFDT")
  .;save for later
  .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 primary care data
  S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECXDATE,"."))
@@ -125 +115 @@
  S (ECXA,ECXMN,ECXADM,ECXTS,ECXW,ECXDIV)="",X=$$INP^ECXUTL2(ECXDFN,ECXDATE)
  S ECXA=$P(X,U),ECXMN=$P(X,U,2),ECXTS=$P(X,U,3),ECXADM=$P(X,U,4),W=$P(X,U,9),ECXDOM=$P(X,U,10),ECXW=$P(W,";"),ECXDIV=$P(W,";",2)
+ Q
+FILE ;file record
+ ;node0
+ ;fac^dfn^ssn^name^i/o^day^va class^qty^ward^cost^movement #^treat spec^ndc^investigational^iv dispensing fee^new feeder key^total doses^
+ ;primary care team^primary care provider^ivp time^adm date^adm time^dss identifier
+ ;node1
+ ;mpi^dss dept^pc provider npi^pc prov person class^assoc pc provider^assoc pc prov person class^assoc pc prov npi^dom^obs pat ind^enc num^
+ ;ord pr^ordering stop code^ord dt^req phys^nat prod division^means tst^elig^dob^sex^state^county^zip+4^vet^period of svc^pow stat^pow loc^ir stat^ao stat^
+ ;ao loc^purple heart ind.^mst stat^enrollment loc^enrollment cat^enrollment stat^enrollment prior^cnh/sh stat^ord pr npi
+ ;node2
+ ;head & neck cancer ind.^ethnicity^race1^bcma drug dispensed^bcma dose given^bcma unit of administration^bcma ICU flag^
+ ;ordering provider person class^^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet 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
+ N DA,DIK
+ S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
+ S ECODE=EC7_U_EC23_U_ECXDIV_U_DFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
+ S ECODE=ECODE_$$ECXDATE^ECXUTL(ECD,ECXYM)_U_ECVACL_U_ECXCNT_U_ECXW_U
+ ;convert specialty to PTF Code for transmission
+ N ECXDATA
+ S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA)
+ S ECXTS=$G(ECXDATA(7))
+ ;done
+ S ECODE=ECODE_ECXCOST_U_ECXMN_U_ECXTS_U_ECNDC_U_ECINV_U_ECTYP_U_ECNFC_U
+ S ECODE=ECODE_ECST_U_ECPTTM_U_ECPTPR_U_ECDTTM_U_$$ECXDATE^ECXUTL(ECXADM,ECXYM)_U_$$ECXTIME^ECXUTL(ECXADM)_U_ECXDSSI_U
+ ;if outpat and not observ patient, admit date="" and admit time="000000"
+ I ECXA="O",(ECXOBS="NO") S $P(ECODE,U,24)="",$P(ECODE,U,25)="000000"
+ S ECODE1=ECXMPI_U_ECXDSSD_U_ECPTNPI_U_ECCLAS_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U_ECXORDPR_U
+ S ECODE1=ECODE1_ECXORDST_U_$$ECXDATE^ECXUTL(ECXORDDT,ECXYM)_U_ECXRPHY_U_ECXPDIV_U_ECXMTST_U_ECXELIG_U_ECXDOB_U
+ S ECODE1=ECODE1_ECXSEX_U_ECXSTATE_U_ECXCNTY_U_ECXZIP_U_ECXVET_U_ECXPOS_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXAST_U
+ S ECODE1=ECODE1_ECXAOL_U_ECXPHI_U_ECXMST_U_ECXENRL_U_ECXCAT_U
+ S ECODE1=ECODE1_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXCNHU_U_ECXOPNPI_U
+ S ECODE2=ECXHNCI_U_ECXETH_U_ECXRC1
+ I ECXLOGIC>2003 D
+ .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
+ S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1
+ S ^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1
+ S DA=EC7,DIK="^ECX("_ECFILE_"," D IX^DIK K DIK,DA
+ I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
  Q
 SETUP ;Set required input for ECXTRAC