ECXTRT1 ;ALB/JAP Treating Specialty Change Extract (cont) ; July 22, 1998
;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
;
PREVTRT(ECXLOC,ECXDATE1,ECXDATE2,ECXTRTL,ECXLOS) ;find the date on which the change to the losing treat. spec. occurred
; input
; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
; ECXDATE1 = inverse date of current (new) ts movement; required)
; ECXDATE2 = inverse date of previous (losing) ts movement; required
; ECXTRTL = pointer value to file #45.7 for previous facility
; treating specialty; required
; output
; ECXLOS = patients length of stay on previous (losing) ts (passed by reference)
;
N DATE,DATE3,X,X1,X2
S DATE=ECXDATE2,DATE3="",ECXLOS=0
F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)) Q:TRT'=ECXTRTL
;if date=null, then get immediately previous date by reverse $o
;if date=null, this gets the last date in ecxloc array, i.e., the admission ts movement
S DATE3=$O(ECXLOC(DATE),-1)
S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
S ECXLOS=X S:ECXLOS>9999 ECXLOS=9999
Q
;
PREVATT(ECXLOC,ECXDATE1,ECXATTN,ECXDATE2,ECXATTL,ECXLOS) ;find the date on which the change to the losing attending occurred
; input
; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
; ECXDATE1 = inverse date of current (new) attending; required)
; ECXATTN = specifier for current (new) attending; required
; ECXDATE2 = inverse date of previous (losing) attending; required
; ECXATTL = specifier for previous (losing) attending (passed by reference); required
; output
; ECXLOSA = patients length of stay with previous (losing) attending (passed by reference)
;
N DATE,DATE3,X,X1,X2,TRT,REC,ATT,OUT
S (DATE,DATE3)=ECXDATE2,ECXLOSA="",OUT=0
I ECXATTL'="" D
.F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
..S ATT=$P(ECXLOC(DATE,TRT,REC),U,3)
..;if provider is changed, then quit without resetting date3, and quit loop
..I ATT'="",ATT'=ECXATTL S OUT=1
..;there's probably always data on attending, so this may not be needed;
..;but if att=null, then dont know if provider in ecxattl was attending or not, so don't reset date3;
..;reset date3 only if know for sure
..I ATT=ECXATTL S DATE3=DATE
.;so date3 is earliest known date for attending specified in ecxattl
.S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
.S ECXLOSA=X
;theres probably always data on attending, so this may not be needed;
;but if ecxattl is null, then need to find valid previous attending
I ECXATTL="" D
.;ecxattn will also be null if evaluating discharge movements
.F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
..S ATT=$P(ECXLOC(DATE,TRT,REC),U,3)
..;if no change in attending, then keep ecxlosa=null
..I ATT'="",ATT=ECXATTN S OUT=1
..I ATT'="",ATT'=ECXATTN D
...;reset ecxattl to send back to caller and calculate los
...S OUT=1,ECXATTL=ATT,DATE3=DATE
...S X1=99999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
...S ECXLOSA=X
;it is possible that ecxattl and ecxlosa will still be null
S:ECXLOSA>9999 ECXLOSA=9999
Q
;
PREVPRV(ECXLOC,ECXDATE1,ECXPRVN,ECXDATE2,ECXPRVL,ECXLOS) ;find the date on which the change to the losing primary provider occurred
; input
; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
; ECXDATE1 = inverse date of current (new) primary provider; required)
; ECXPRVN = specifier for current (new) primary provider; required
; ECXDATE2 = inverse date of previous (losing) primary provider; required
; ECXPRVL = specifier for previous (losing) primary provider 9passed by reference); required
; output
; ECXLOSP = patients length of stay with previous (losing) primary provider (passed by reference)
;
N DATE,DATE3,X,X1,X2,TRT,REC,PRV,OUT
S (DATE,DATE3)=ECXDATE2,ECXLOSP="",OUT=0
I ECXPRVL'="" D
.F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
..S PRV=$P(ECXLOC(DATE,TRT,REC),U,2)
..;if provider is changed, then quit without resetting date3, and quit loop
..I PRV'="",PRV'=ECXPRVL S OUT=1
..;if prv=null, then don't know if provider in ecxprvl was patient's provider or not, so don't reset date3;
..;reset date3 only if know for sure
..I PRV=ECXPRVL S DATE3=DATE
.;so date3 is earliest known date for attending specified in ecxattl
.S X1=9999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
.S ECXLOSP=X
;if ecxprvl is null, then need to find valid previous primary provider
I ECXPRVL="" D
.;ecxprvn will also be null if evaluating discharge movements
.F S DATE=$O(ECXLOC(DATE)) Q:DATE="" S TRT=$O(ECXLOC(DATE,0)),REC=$O(ECXLOC(DATE,TRT,0)) D Q:OUT=1
..S PRV=$P(ECXLOC(DATE,TRT,REC),U,2)
..;if no change in primary provider, then keep ecxlosp=null
..I PRV'="",PRV=ECXPRVN S OUT=1
..I PRV'="",PRV'=ECXPRVN D
...;reset ecxprvl to send back to caller and calculate los
...S OUT=1,ECXPRVL=PRV,DATE3=DATE
...S X1=99999999.9999999-ECXDATE1,X2=9999999.9999999-DATE3 D ^%DTC
...S ECXLOSP=X
;it is possible that ecxprvl and ecxlosp will still be null
S:ECXLOSP>9999 ECXLOSP=9999
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXTRT1 5381 printed Dec 13, 2024@01:54:08 Page 2
ECXTRT1 ;ALB/JAP Treating Specialty Change Extract (cont) ; July 22, 1998
+1 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
+2 ;
PREVTRT(ECXLOC,ECXDATE1,ECXDATE2,ECXTRTL,ECXLOS) ;find the date on which the change to the losing treat. spec. occurred
+1 ; input
+2 ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
+3 ; ECXDATE1 = inverse date of current (new) ts movement; required)
+4 ; ECXDATE2 = inverse date of previous (losing) ts movement; required
+5 ; ECXTRTL = pointer value to file #45.7 for previous facility
+6 ; treating specialty; required
+7 ; output
+8 ; ECXLOS = patients length of stay on previous (losing) ts (passed by reference)
+9 ;
+10 NEW DATE,DATE3,X,X1,X2
+11 SET DATE=ECXDATE2
SET DATE3=""
SET ECXLOS=0
+12 FOR
SET DATE=$ORDER(ECXLOC(DATE))
if DATE=""
QUIT
SET TRT=$ORDER(ECXLOC(DATE,0))
if TRT'=ECXTRTL
QUIT
+13 ;if date=null, then get immediately previous date by reverse $o
+14 ;if date=null, this gets the last date in ecxloc array, i.e., the admission ts movement
+15 SET DATE3=$ORDER(ECXLOC(DATE),-1)
+16 SET X1=9999999.9999999-ECXDATE1
SET X2=9999999.9999999-DATE3
DO ^%DTC
+17 SET ECXLOS=X
if ECXLOS>9999
SET ECXLOS=9999
+18 QUIT
+19 ;
PREVATT(ECXLOC,ECXDATE1,ECXATTN,ECXDATE2,ECXATTL,ECXLOS) ;find the date on which the change to the losing attending occurred
+1 ; input
+2 ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
+3 ; ECXDATE1 = inverse date of current (new) attending; required)
+4 ; ECXATTN = specifier for current (new) attending; required
+5 ; ECXDATE2 = inverse date of previous (losing) attending; required
+6 ; ECXATTL = specifier for previous (losing) attending (passed by reference); required
+7 ; output
+8 ; ECXLOSA = patients length of stay with previous (losing) attending (passed by reference)
+9 ;
+10 NEW DATE,DATE3,X,X1,X2,TRT,REC,ATT,OUT
+11 SET (DATE,DATE3)=ECXDATE2
SET ECXLOSA=""
SET OUT=0
+12 IF ECXATTL'=""
Begin DoDot:1
+13 FOR
SET DATE=$ORDER(ECXLOC(DATE))
if DATE=""
QUIT
SET TRT=$ORDER(ECXLOC(DATE,0))
SET REC=$ORDER(ECXLOC(DATE,TRT,0))
Begin DoDot:2
+14 SET ATT=$PIECE(ECXLOC(DATE,TRT,REC),U,3)
+15 ;if provider is changed, then quit without resetting date3, and quit loop
+16 IF ATT'=""
IF ATT'=ECXATTL
SET OUT=1
+17 ;there's probably always data on attending, so this may not be needed;
+18 ;but if att=null, then dont know if provider in ecxattl was attending or not, so don't reset date3;
+19 ;reset date3 only if know for sure
+20 IF ATT=ECXATTL
SET DATE3=DATE
End DoDot:2
if OUT=1
QUIT
+21 ;so date3 is earliest known date for attending specified in ecxattl
+22 SET X1=9999999.9999999-ECXDATE1
SET X2=9999999.9999999-DATE3
DO ^%DTC
+23 SET ECXLOSA=X
End DoDot:1
+24 ;theres probably always data on attending, so this may not be needed;
+25 ;but if ecxattl is null, then need to find valid previous attending
+26 IF ECXATTL=""
Begin DoDot:1
+27 ;ecxattn will also be null if evaluating discharge movements
+28 FOR
SET DATE=$ORDER(ECXLOC(DATE))
if DATE=""
QUIT
SET TRT=$ORDER(ECXLOC(DATE,0))
SET REC=$ORDER(ECXLOC(DATE,TRT,0))
Begin DoDot:2
+29 SET ATT=$PIECE(ECXLOC(DATE,TRT,REC),U,3)
+30 ;if no change in attending, then keep ecxlosa=null
+31 IF ATT'=""
IF ATT=ECXATTN
SET OUT=1
+32 IF ATT'=""
IF ATT'=ECXATTN
Begin DoDot:3
+33 ;reset ecxattl to send back to caller and calculate los
+34 SET OUT=1
SET ECXATTL=ATT
SET DATE3=DATE
+35 SET X1=99999999.9999999-ECXDATE1
SET X2=9999999.9999999-DATE3
DO ^%DTC
+36 SET ECXLOSA=X
End DoDot:3
End DoDot:2
if OUT=1
QUIT
End DoDot:1
+37 ;it is possible that ecxattl and ecxlosa will still be null
+38 if ECXLOSA>9999
SET ECXLOSA=9999
+39 QUIT
+40 ;
PREVPRV(ECXLOC,ECXDATE1,ECXPRVN,ECXDATE2,ECXPRVL,ECXLOS) ;find the date on which the change to the losing primary provider occurred
+1 ; input
+2 ; ECXLOC = local array built from ATS index on file #405 (passed by reference); required
+3 ; ECXDATE1 = inverse date of current (new) primary provider; required)
+4 ; ECXPRVN = specifier for current (new) primary provider; required
+5 ; ECXDATE2 = inverse date of previous (losing) primary provider; required
+6 ; ECXPRVL = specifier for previous (losing) primary provider 9passed by reference); required
+7 ; output
+8 ; ECXLOSP = patients length of stay with previous (losing) primary provider (passed by reference)
+9 ;
+10 NEW DATE,DATE3,X,X1,X2,TRT,REC,PRV,OUT
+11 SET (DATE,DATE3)=ECXDATE2
SET ECXLOSP=""
SET OUT=0
+12 IF ECXPRVL'=""
Begin DoDot:1
+13 FOR
SET DATE=$ORDER(ECXLOC(DATE))
if DATE=""
QUIT
SET TRT=$ORDER(ECXLOC(DATE,0))
SET REC=$ORDER(ECXLOC(DATE,TRT,0))
Begin DoDot:2
+14 SET PRV=$PIECE(ECXLOC(DATE,TRT,REC),U,2)
+15 ;if provider is changed, then quit without resetting date3, and quit loop
+16 IF PRV'=""
IF PRV'=ECXPRVL
SET OUT=1
+17 ;if prv=null, then don't know if provider in ecxprvl was patient's provider or not, so don't reset date3;
+18 ;reset date3 only if know for sure
+19 IF PRV=ECXPRVL
SET DATE3=DATE
End DoDot:2
if OUT=1
QUIT
+20 ;so date3 is earliest known date for attending specified in ecxattl
+21 SET X1=9999999.9999999-ECXDATE1
SET X2=9999999.9999999-DATE3
DO ^%DTC
+22 SET ECXLOSP=X
End DoDot:1
+23 ;if ecxprvl is null, then need to find valid previous primary provider
+24 IF ECXPRVL=""
Begin DoDot:1
+25 ;ecxprvn will also be null if evaluating discharge movements
+26 FOR
SET DATE=$ORDER(ECXLOC(DATE))
if DATE=""
QUIT
SET TRT=$ORDER(ECXLOC(DATE,0))
SET REC=$ORDER(ECXLOC(DATE,TRT,0))
Begin DoDot:2
+27 SET PRV=$PIECE(ECXLOC(DATE,TRT,REC),U,2)
+28 ;if no change in primary provider, then keep ecxlosp=null
+29 IF PRV'=""
IF PRV=ECXPRVN
SET OUT=1
+30 IF PRV'=""
IF PRV'=ECXPRVN
Begin DoDot:3
+31 ;reset ecxprvl to send back to caller and calculate los
+32 SET OUT=1
SET ECXPRVL=PRV
SET DATE3=DATE
+33 SET X1=99999999.9999999-ECXDATE1
SET X2=9999999.9999999-DATE3
DO ^%DTC
+34 SET ECXLOSP=X
End DoDot:3
End DoDot:2
if OUT=1
QUIT
End DoDot:1
+35 ;it is possible that ecxprvl and ecxlosp will still be null
+36 if ECXLOSP>9999
SET ECXLOSP=9999
+37 QUIT
