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

VAFCADT3.m

Go to the documentation of this file.
  1. VAFCADT3 ;ALB/RJS - GOES THROUGH APCA & ATS CROSS-REFERENCE - 5/16/95
  1. ;;5.3;Registration;**91**;Jun 06, 1996
  1. BLDHIST(DFN,ADMSSN,ARRAY) ;
  1. ;
  1. ;This Routine builds a history of an ADMISSION (ADMSSN)
  1. ;for a Patient with a certain (DFN)
  1. ;
  1. ;The APCA cross-reference catches all Admit Discharge Transfer
  1. ;(ADT) events
  1. ;
  1. ;The ATS cross-reference catches all Specialty Transfers
  1. ;
  1. ;The History is returned in the array specified in the array
  1. ;variable, which can be global or local, e.g. "ZIMBA" OR "^TMP($J)"
  1. ;if ARRAY is "" or not-defined it is returned in local variable
  1. ;VAFCADT3
  1. ;
  1. ;
  1. Q:$G(DFN)=""!($G(ADMSSN)="")
  1. N VADATE,IEN,SPEC,TT,ACTDATE
  1. I $G(ARRAY)="" S ARRAY="VAFCADT3"
  1. ;
  1. ;--$O Through "apca" cross reference of patient movement file
  1. ; looking for admission, discharge, and transfer events
  1. ;
  1. S VADATE=""
  1. F S VADATE=$O(^DGPM("APCA",DFN,ADMSSN,VADATE)) Q:VADATE="" D
  1. . S IEN=""
  1. . F S IEN=$O(^DGPM("APCA",DFN,ADMSSN,VADATE,IEN)) Q:IEN="" D
  1. . . S TT=$P($G(^DGPM(IEN,0)),"^",2),ACTDATE=$P($G(^DGPM(IEN,0)),"^",1)
  1. . . I TT'=""&("123"[TT) D
  1. . . . S @ARRAY@(ACTDATE,IEN)=$S(TT=1:"ADMISSION",TT=2:"TRANSFER",TT=3:"DISCHARGE")
  1. . . . I $$ASSOCTD(DFN,ADMSSN,$$CONVERT(ACTDATE)) S @ARRAY@(ACTDATE,IEN)=@ARRAY@(ACTDATE,IEN)_",SPECIALTY"
  1. ;
  1. ;--$O Through "ats" cross reference of patient movement file
  1. ; looking for specialty transfer events
  1. ;
  1. S VADATE=""
  1. F S VADATE=$O(^DGPM("ATS",DFN,ADMSSN,VADATE)) Q:VADATE="" D
  1. . S SPEC=""
  1. . F S SPEC=$O(^DGPM("ATS",DFN,ADMSSN,VADATE,SPEC)) Q:SPEC="" D
  1. . . S IEN=""
  1. . . F S IEN=$O(^DGPM("ATS",DFN,ADMSSN,VADATE,SPEC,IEN)) Q:IEN="" D
  1. . . . S ACTDATE=$P($G(^DGPM(IEN,0)),"^",1),TT=$P($G(^DGPM(IEN,0)),"^",2)
  1. . . . I TT'=""&("6"[TT) D
  1. . . . . I '$D(@ARRAY@(ACTDATE)) S @ARRAY@(ACTDATE,IEN)="SPECIALTY"
  1. ;
  1. ;--$O through array created, looking to flag the last movement as
  1. ; "LASTONE"
  1. ;
  1. Q:'$D(@ARRAY)
  1. S VADATE="",VADATE=$O(@ARRAY@(VADATE),-1)
  1. S IEN="",IEN=$O(@ARRAY@(VADATE,IEN),-1)
  1. S @ARRAY@(VADATE,IEN)=@ARRAY@(VADATE,IEN)_",LASTONE"
  1. Q
  1. ;
  1. CONVERT(VADATE) ;
  1. Q:$G(VADATE)="" -1
  1. S VADATE=9999999.9999999-VADATE
  1. Q VADATE
  1. ASSOCTD(DFN,ADMSSN,VADATE,IEN) ;
  1. N RESULT
  1. Q:$D(^DGPM("ATS",DFN,ADMSSN,VADATE)) 1
  1. Q 0