Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXLBB1

ECXLBB1.m

Go to the documentation of this file. 
  1. ECXLBB1 ;ALB/JRC - DSS VBECS EXTRACT ;7/3/18  15:06
  1.  ;;3.0;DSS EXTRACTS;**105,102,120,127,144,156,161,170,184**;Dec 22, 1997;Build 124
  1.  ;Per VA Directive 6402, this routine should not be modified.  Medical Device # BK970021
  1.  ; access to the VBECS EXTRACT file (#6002.03) is supported by
  1.  ; controlled subscription to IA #4953  (global root ^VBECS(6002.03)
  1. BEG ;entry point from option
  1.  D SETUP I ECFILE="" Q
  1.  D ^ECXTRAC,^ECXKILL
  1.  Q
  1.  ;
  1. START ; Entry point from tasked job
  1.  ; begin package specific extract
  1.  N ECTRSP,ECADMT,ECTODT,ECENCTR,ECPAT,ECLRDFN,ECXPHY,ECXPHYPC
  1.  N ECD,ECXDFN,ECARRY,EC66,ECERR,ECTRFDT,ECTRFTM,ECX,ECINOUT,ECXINST
  1.  N ECPHYNPI,ECREQNPI,ECXPATCAT,ECXESC ;144
  1.  ;variables ECFILE,EC23,ECXYM,ECINST,ECSD,ECSD1,ECED passed in 
  1.  ; by taskmanager 
  1.  ; ECED defined in ^ECXTRAC - end date of the extract
  1.  ; TRANSFUSION DATE should be within start and end dates
  1.  ; ECED and ECSD input provided by the user interface
  1.  ; and ECSD1 = ECSD-.1
  1.  ; Read through the VBECS DSS EXTRACT file (6002.03)
  1.  I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 Q  ;quit if tasked and user sends stop request  (QFLG assigned in ECXTRAC)
  1.  ;
  1. AUDRPT ; entry point for pre-extract audit report
  1.  N RECORD
  1.  S RECORD=0,ECD=ECSD-.1,ECTODT=ECED+.9
  1.  F  S ECD=$O(^VBEC(6002.03,"C",ECD)) Q:'ECD!(ECD>ECTODT)  S RECORD=0 F  S RECORD=$O(^VBEC(6002.03,"C",ECD,RECORD)) Q:RECORD'>0  S EC0=^VBEC(6002.03,RECORD,0) D
  1.  .; ECARRY(1)=TRANSFUSION DATE AND TIME, ECARRY(3)=COMPONENT 
  1.  .; ECARRY(4)=COMPONENT ABBREVIATION, ECARRY(5)=UNITS POOLED
  1.  .; ECARRY(6)=TRANSFUSION REACTION,ECARRY(7)=VOLUME TRANSFUSED
  1.  .; ECARRY(8)=TRANSFUSION REACTION TYPE, ECARRY(9)=REQUESTING PROVIDER
  1.  .; ECARRY(10)=REQUEST. PROV. PERSON CLASS, ECARRY(11)=UNIT MODIFIED
  1.  .; ECARRY(12)=UNIT MODIFICATION, ECARRY(13)=PRODUCTION DIVISION CODE
  1.  .;
  1.  . S ECXDFN=$P(EC0,U,2),ECERR=$$PAT(ECXDFN) Q:ECERR
  1.  . S ECARRY(1)=$P(EC0,U,10),ECARRY(3)=$P(EC0,U,7),ECARRY(4)=$P(EC0,U,8),ECARRY(5)=$S(+$P(EC0,U,9)=0:1,1:+$P(EC0,U,9)),ECARRY(6)=$S($P(EC0,U,15):"Y",1:"N"),ECARRY(7)=$P(EC0,"^",12),ECARRY(8)=$P(EC0,U,13)
  1.  . S ECARRY(9)=$P(EC0,U,6),ECINST=$P(EC0,U,3),ECARRY(12)=$P(EC0,U,14),ECARRY(11)=$S(ECARRY(12)'="":"Y",1:"N"),ECARRY(13)=$P(EC0,U,4)
  1.  . ;get requesting and ordering providers and their person class
  1.  . S ECXPHY=$P(EC0,U,5),(ECXPHYPC,ECARRY(10),ECPHYNPI,ECREQNPI)=""
  1.  . I ECXPHY]"" S ECXPHY=$O(^VA(200,"B",ECXPHY,0))
  1.  . I ECXPHY>0 D
  1.  .. N PERCLS S PERCLS=$$GET^XUA4A72(ECXPHY,ECD)
  1.  .. I +PERCLS>0 S ECXPHYPC=$P(PERCLS,U,7)
  1.  .. S ECPHYNPI=$$NPI^XUSNPI("Individual_ID",ECXPHY,ECD)
  1.  .. S:+ECPHYNPI'>0 ECPHYNPI="" S ECPHYNPI=$P(ECPHYNPI,U)
  1.  .. S ECXPHY=2_ECXPHY
  1.  . I ECARRY(9)>0 D
  1.  .. N PERCLS S PERCLS=$$GET^XUA4A72(ECARRY(9),ECD)
  1.  .. I +PERCLS>0 S ECARRY(10)=$P(PERCLS,U,7)
  1.  .. S ECREQNPI=$$NPI^XUSNPI("Individual_ID",ECARRY(9),ECD)
  1.  .. S:+ECREQNPI'>0 ECREQNPI="" S ECREQNPI=$P(ECREQNPI,U)
  1.  .. S ECARRY(9)=2_ECARRY(9)
  1.  . D GETDATA
  1.  . K ECARRY
  1.  Q
  1.  ;
  1. GETDATA ; gather rest of extract data that will be recorded in an 
  1.  ; entry in file 727.829
  1.  N ECXSTR,ECXASIH ;170
  1.  N ECXNMPI,ECXCERN,ECXSIGI ;184 - fields added
  1.  S ECTRFDT=$$ECXDOB^ECXUTL(ECARRY(1)),ECTRFTM=$$ECXTIME^ECXUTL(ECARRY(1))
  1.  S ECX=$$INP^ECXUTL2(ECXDFN,ECARRY(1)),ECINOUT=$P(ECX,U),ECTRSP=$P(ECX,U,3),ECADMT=$P(ECX,U,4),ECXASIH=$P(ECX,U,14) ;170
  1.  ;
  1.  ;- Observation patient indicator (YES/NO)
  1.  S ECXOBS=$$OBSPAT^ECXUTL4(ECINOUT,ECTRSP)
  1.  ;- If no encounter number don't file record
  1.  S ECENCTR=$$ENCNUM^ECXUTL4(ECINOUT,ECPAT("SSN"),ECADMT,ECARRY(1),ECTRSP,ECXOBS,ECHEAD,,) ; [FLD #6]
  1.  Q:ECENCTR=""
  1.  ;get emergency response indicator (FEMA)
  1.  S ECXERI=$G(ECPAT("ERI"))
  1.  ;184 - Get New MPI and Self Identified Gender
  1.  S ECXNMPI=ECPAT("MPI")
  1.  S ECXSIGI=ECPAT("SIGI")
  1.  ;
  1.  ; ******* - PATCH 127, ADD PATCAT CODE ********
  1.  S ECXPATCAT=$$PATCAT^ECXUTL(ECXDFN)
  1.  S ECXESC="" ;144
  1.  I $G(ECXASIH) S ECINOUT="A" ;170
  1.  S ECXSTR=$G(EC23)_"^"_ECINST_"^"_ECXDFN_"^"_ECPAT("SSN")_"^"_ECPAT("NAME")_"^"_ECINOUT_"^"_ECENCTR_"^"_ECTRFDT_"^"_ECTRFTM_"^"_ECARRY(3)_"^"_ECARRY(4)_"^"_ECARRY(5)_"^"_ECARRY(7)_"^"_ECARRY(6)_"^"_ECARRY(8)_"^BB"_ECARRY(13)_"^^"
  1.  I $G(ECXLOGIC)>2005 S ECXSTR=ECXSTR_U_ECXPHY_U_ECXPHYPC
  1.  I $G(ECXLOGIC)>2006 D
  1.  .S ECXSTR=ECXSTR_U_ECXERI_U_ECARRY(11)_U_ECARRY(12)_U_ECARRY(9)_U_ECARRY(10)_U_ECARRY(13)_U
  1.  I $G(ECXLOGIC)>2022 S ECXSTR=ECXSTR_ECPAT("SIGI") ;184
  1.  I '$D(ECXRPT) D FILE(ECXSTR) Q
  1.  S ^TMP("ECXLBB",$J,ECXDFN,ECD,RECORD)=ECXSTR  ;temporary global array,156-added additional subscript
  1.  I $D(ECXCRPT) D
  1.  . N ECCOUNT S ECCOUNT=0
  1.  . F  S ECCOUNT=ECCOUNT+1 Q:'$D(^TMP("ECXLBBC",$J,$S($G(ECXCFLG)=1:ECARRY(4),1:"ZZNOZZ"),ECXDFN,ECTRFDT_"."_ECTRFTM_"."_ECCOUNT,"S"))
  1.  . S ^TMP("ECXLBBC",$J,$S($G(ECXCFLG)=1:ECARRY(4),1:"ZZNOZZ"),ECXDFN,ECTRFDT_"."_ECTRFTM_"."_ECCOUNT,"S")=ECXSTR
  1.  ;   used in ECXPLBB/ECXLBBC (pre-extract audit report)
  1.  Q
  1.  ;
  1. PAT(ECXDFN) ;get/set patient data
  1.  ; INPUT - ECXDFN = patient ien (DFN)
  1.  ; OUTPUT - ECPAT array:
  1.  ;          ECPAT("SSN")
  1.  ;          ECPAT("NAME")
  1.  ; returns 0 or 1 in ECXERR - 0=successful
  1.  ;                            1=error condition
  1.  N X,OK,ECXERR
  1.  ;get data
  1.  S ECXERR=0
  1.  K ECXPAT S OK=$$PAT^ECXUTL3(ECXDFN,"","1;3",.ECPAT)
  1.  I 'OK S ECXERR=1
  1.  Q ECXERR
  1.  ;
  1. FILE(ECODE) ;
  1.  ; Input - ECODE = extract record
  1.  ;
  1.  ; record the extract record at a global node in file 727.829
  1.  ; sequence #^year/month of extract^extract #^facility^patient dfn^SSN^
  1.  ; name^i/o pt indicator^encounter #^date of transfusion^time of 
  1.  ; transfusion^component^component abbrev^# of units^volume in mm^
  1.  ; reaction^reaction type^feeder location^placeholder^DSS IP #
  1.  ; ordering physician^ordering physician pc^emergency response indicator
  1.  ; (FEMA)^unit modified^unit modification^requesting provider^request. 
  1.  ; provider person class^ordering provider npi ECPHYNPI
  1.  ;ECODE1- requesting provider npi ECREQNPI^PATCAT^Encounter SC ECXESC
  1.  ;ECODE2 - Cerner Data
  1.  ;ECODE3 - New MPI (ECXNMPI)^Self Identified Gender (ECXSIGI)
  1.  N DA,DIK,EC7
  1.  S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
  1.  S ECODE=EC7_"^"_ECODE
  1.  I ECXLOGIC>2007 D
  1.  .S ECODE=ECODE_ECPHYNPI_U
  1.  .S ECODE1=$G(ECREQNPI)
  1.  .I ECXLOGIC>2010 S ECODE1=ECODE1_U_ECXPATCAT
  1.  I ECXLOGIC>2013 S ECODE1=ECODE1_U_ECXESC_U ;144 ,184 - Added "^"
  1.  I ECXLOGIC>2022 S ECODE2=$G(ECXCERN)_U,ECODE3=ECXNMPI_U_ECXSIGI ;184
  1.  S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=$G(ECODE1) ; 184 Moved record count to below
  1.  S ^ECX(ECFILE,EC7,2)=$G(ECODE2),^ECX(ECFILE,EC7,3)=$G(ECODE3) ;184
  1.  S ECRN=ECRN+1 ;184 Moved from above
  1.  S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
  1.  Q
  1.  ;
  1. SETUP ;Set required input for ECXTRAC.
  1.  S ECHEAD="LBB"
  1.  D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
  1.  Q
  1.  ;
  1. LOCAL ; to extract nightly for local use not to be transmitted to TSI
  1.  ; should be queued with a 1D frequency
  1.  D SETUP,^ECXTLOCL,^ECXKILL Q
  1.  ;
  1. CHKMOD(MD) ;check if modifier is contained in string
  1.  N RES,MODX
  1.  I MD="" Q ""
  1.  S (RES,MODX)="" F  S MODX=$O(MODARY(MODX)) Q:MODX=""  D  I RES'="" Q
  1.  .I MD[MODX S RES=MODARY(MODX)
  1.  Q RES
  1.  ;
  1. QUE ; entry point for the background requeuing handled by ECXTAUTO
  1.  D SETUP,QUE^ECXTAUTO,^ECXKILL
  1.  Q
  1.  ;
  1.  ;ECXLBB