- 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 Feb 18, 2025@23:20:32 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