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

ECXTRT1.m

Go to the documentation of this file.
  1. ECXTRT1 ;ALB/JAP Treating Specialty Change Extract (cont) ; July 22, 1998
  1. ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
  1. ;
  1. PREVTRT(ECXLOC,ECXDATE1,ECXDATE2,ECXTRTL,ECXLOS) ;find the date on which the change to the losing treat. spec. occurred
  1. ; input
  1. ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
  1. ; ECXDATE1 = inverse date of current (new) ts movement; required)
  1. ; ECXDATE2 = inverse date of previous (losing) ts movement; required
  1. ; ECXTRTL = pointer value to file #45.7 for previous facility
  1. ; treating specialty; required
  1. ; output
  1. ; ECXLOS = patients length of stay on previous (losing) ts (passed by reference)
  1. ;
  1. N DATE,DATE3,X,X1,X2
  1. S DATE=ECXDATE2,DATE3="",ECXLOS=0
  1. F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)) Q:TRT'=ECXTRTL
  1. ;if date=null, then get immediately previous date by reverse $o
  1. ;if date=null, this gets the last date in ecxloc array, i.e., the admission ts movement
  1. S DATE3=$O(ECXLOC(DATE),-1)
  1. S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
  1. S ECXLOS=X S:ECXLOS>9999 ECXLOS=9999
  1. Q
  1. ;
  1. PREVATT(ECXLOC,ECXDATE1,ECXATTN,ECXDATE2,ECXATTL,ECXLOS) ;find the date on which the change to the losing attending occurred
  1. ; input
  1. ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
  1. ; ECXDATE1 = inverse date of current (new) attending; required)
  1. ; ECXATTN = specifier for current (new) attending; required
  1. ; ECXDATE2 = inverse date of previous (losing) attending; required
  1. ; ECXATTL = specifier for previous (losing) attending (passed by reference); required
  1. ; output
  1. ; ECXLOSA = patients length of stay with previous (losing) attending (passed by reference)
  1. ;
  1. N DATE,DATE3,X,X1,X2,TRT,REC,ATT,OUT
  1. S (DATE,DATE3)=ECXDATE2,ECXLOSA="",OUT=0
  1. I ECXATTL'="" D
  1. .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
  1. ..S ATT=$P(ECXLOC(DATE,TRT,REC),U,3)
  1. ..;if provider is changed, then quit without resetting date3, and quit loop
  1. ..I ATT'="",ATT'=ECXATTL S OUT=1
  1. ..;there's probably always data on attending, so this may not be needed;
  1. ..;but if att=null, then dont know if provider in ecxattl was attending or not, so don't reset date3;
  1. ..;reset date3 only if know for sure
  1. ..I ATT=ECXATTL S DATE3=DATE
  1. .;so date3 is earliest known date for attending specified in ecxattl
  1. .S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
  1. .S ECXLOSA=X
  1. ;theres probably always data on attending, so this may not be needed;
  1. ;but if ecxattl is null, then need to find valid previous attending
  1. I ECXATTL="" D
  1. .;ecxattn will also be null if evaluating discharge movements
  1. .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
  1. ..S ATT=$P(ECXLOC(DATE,TRT,REC),U,3)
  1. ..;if no change in attending, then keep ecxlosa=null
  1. ..I ATT'="",ATT=ECXATTN S OUT=1
  1. ..I ATT'="",ATT'=ECXATTN D
  1. ...;reset ecxattl to send back to caller and calculate los
  1. ...S OUT=1,ECXATTL=ATT,DATE3=DATE
  1. ...S X1=99999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
  1. ...S ECXLOSA=X
  1. ;it is possible that ecxattl and ecxlosa will still be null
  1. S:ECXLOSA>9999 ECXLOSA=9999
  1. Q
  1. ;
  1. PREVPRV(ECXLOC,ECXDATE1,ECXPRVN,ECXDATE2,ECXPRVL,ECXLOS) ;find the date on which the change to the losing primary provider occurred
  1. ; input
  1. ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
  1. ; ECXDATE1 = inverse date of current (new) primary provider; required)
  1. ; ECXPRVN = specifier for current (new) primary provider; required
  1. ; ECXDATE2 = inverse date of previous (losing) primary provider; required
  1. ; ECXPRVL = specifier for previous (losing) primary provider 9passed by reference); required
  1. ; output
  1. ; ECXLOSP = patients length of stay with previous (losing) primary provider (passed by reference)
  1. ;
  1. N DATE,DATE3,X,X1,X2,TRT,REC,PRV,OUT
  1. S (DATE,DATE3)=ECXDATE2,ECXLOSP="",OUT=0
  1. I ECXPRVL'="" D
  1. .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
  1. ..S PRV=$P(ECXLOC(DATE,TRT,REC),U,2)
  1. ..;if provider is changed, then quit without resetting date3, and quit loop
  1. ..I PRV'="",PRV'=ECXPRVL S OUT=1
  1. ..;if prv=null, then don't know if provider in ecxprvl was patient's provider or not, so don't reset date3;
  1. ..;reset date3 only if know for sure
  1. ..I PRV=ECXPRVL S DATE3=DATE
  1. .;so date3 is earliest known date for attending specified in ecxattl
  1. .S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
  1. .S ECXLOSP=X
  1. ;if ecxprvl is null, then need to find valid previous primary provider
  1. I ECXPRVL="" D
  1. .;ecxprvn will also be null if evaluating discharge movements
  1. .F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
  1. ..S PRV=$P(ECXLOC(DATE,TRT,REC),U,2)
  1. ..;if no change in primary provider, then keep ecxlosp=null
  1. ..I PRV'="",PRV=ECXPRVN S OUT=1
  1. ..I PRV'="",PRV'=ECXPRVN D
  1. ...;reset ecxprvl to send back to caller and calculate los
  1. ...S OUT=1,ECXPRVL=PRV,DATE3=DATE
  1. ...S X1=99999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
  1. ...S ECXLOSP=X
  1. ;it is possible that ecxprvl and ecxlosp will still be null
  1. S:ECXLOSP>9999 ECXLOSP=9999
  1. Q