| 1 | VAFCADT3 ;ALB/RJS - GOES THROUGH APCA & ATS CROSS-REFERENCE - 5/16/95
|
|---|
| 2 | ;;5.3;Registration;**91**;Jun 06, 1996
|
|---|
| 3 | BLDHIST(DFN,ADMSSN,ARRAY) ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;This Routine builds a history of an ADMISSION (ADMSSN)
|
|---|
| 6 | ;for a Patient with a certain (DFN)
|
|---|
| 7 | ;
|
|---|
| 8 | ;The APCA cross-reference catches all Admit Discharge Transfer
|
|---|
| 9 | ;(ADT) events
|
|---|
| 10 | ;
|
|---|
| 11 | ;The ATS cross-reference catches all Specialty Transfers
|
|---|
| 12 | ;
|
|---|
| 13 | ;The History is returned in the array specified in the array
|
|---|
| 14 | ;variable, which can be global or local, e.g. "ZIMBA" OR "^TMP($J)"
|
|---|
| 15 | ;if ARRAY is "" or not-defined it is returned in local variable
|
|---|
| 16 | ;VAFCADT3
|
|---|
| 17 | ;
|
|---|
| 18 | ;
|
|---|
| 19 | Q:$G(DFN)=""!($G(ADMSSN)="")
|
|---|
| 20 | N VADATE,IEN,SPEC,TT,ACTDATE
|
|---|
| 21 | I $G(ARRAY)="" S ARRAY="VAFCADT3"
|
|---|
| 22 | ;
|
|---|
| 23 | ;--$O Through "apca" cross reference of patient movement file
|
|---|
| 24 | ; looking for admission, discharge, and transfer events
|
|---|
| 25 | ;
|
|---|
| 26 | S VADATE=""
|
|---|
| 27 | F S VADATE=$O(^DGPM("APCA",DFN,ADMSSN,VADATE)) Q:VADATE="" D
|
|---|
| 28 | . S IEN=""
|
|---|
| 29 | . F S IEN=$O(^DGPM("APCA",DFN,ADMSSN,VADATE,IEN)) Q:IEN="" D
|
|---|
| 30 | . . S TT=$P($G(^DGPM(IEN,0)),"^",2),ACTDATE=$P($G(^DGPM(IEN,0)),"^",1)
|
|---|
| 31 | . . I TT'=""&("123"[TT) D
|
|---|
| 32 | . . . S @ARRAY@(ACTDATE,IEN)=$S(TT=1:"ADMISSION",TT=2:"TRANSFER",TT=3:"DISCHARGE")
|
|---|
| 33 | . . . I $$ASSOCTD(DFN,ADMSSN,$$CONVERT(ACTDATE)) S @ARRAY@(ACTDATE,IEN)=@ARRAY@(ACTDATE,IEN)_",SPECIALTY"
|
|---|
| 34 | ;
|
|---|
| 35 | ;--$O Through "ats" cross reference of patient movement file
|
|---|
| 36 | ; looking for specialty transfer events
|
|---|
| 37 | ;
|
|---|
| 38 | S VADATE=""
|
|---|
| 39 | F S VADATE=$O(^DGPM("ATS",DFN,ADMSSN,VADATE)) Q:VADATE="" D
|
|---|
| 40 | . S SPEC=""
|
|---|
| 41 | . F S SPEC=$O(^DGPM("ATS",DFN,ADMSSN,VADATE,SPEC)) Q:SPEC="" D
|
|---|
| 42 | . . S IEN=""
|
|---|
| 43 | . . F S IEN=$O(^DGPM("ATS",DFN,ADMSSN,VADATE,SPEC,IEN)) Q:IEN="" D
|
|---|
| 44 | . . . S ACTDATE=$P($G(^DGPM(IEN,0)),"^",1),TT=$P($G(^DGPM(IEN,0)),"^",2)
|
|---|
| 45 | . . . I TT'=""&("6"[TT) D
|
|---|
| 46 | . . . . I '$D(@ARRAY@(ACTDATE)) S @ARRAY@(ACTDATE,IEN)="SPECIALTY"
|
|---|
| 47 | ;
|
|---|
| 48 | ;--$O through array created, looking to flag the last movement as
|
|---|
| 49 | ; "LASTONE"
|
|---|
| 50 | ;
|
|---|
| 51 | Q:'$D(@ARRAY)
|
|---|
| 52 | S VADATE="",VADATE=$O(@ARRAY@(VADATE),-1)
|
|---|
| 53 | S IEN="",IEN=$O(@ARRAY@(VADATE,IEN),-1)
|
|---|
| 54 | S @ARRAY@(VADATE,IEN)=@ARRAY@(VADATE,IEN)_",LASTONE"
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | CONVERT(VADATE) ;
|
|---|
| 58 | Q:$G(VADATE)="" -1
|
|---|
| 59 | S VADATE=9999999.9999999-VADATE
|
|---|
| 60 | Q VADATE
|
|---|
| 61 | ASSOCTD(DFN,ADMSSN,VADATE,IEN) ;
|
|---|
| 62 | N RESULT
|
|---|
| 63 | Q:$D(^DGPM("ATS",DFN,ADMSSN,VADATE)) 1
|
|---|
| 64 | Q 0
|
|---|
