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

BEDDPLKP.m

Go to the documentation of this file. 
  1. BEDDPLKP ;GDIT/HCSD/BEE-Patient Lookup ; 29 Oct 2005  6:51 PM
  1.  ;;2.0;BEDD DASHBOARD;**2,3**;Jun 04, 2014;Build 12
  1.  ;
  1.  ;Adapted from BQIPTLKP
  1.  ;
  1.  Q
  1.  ;
  1. FND(BEDD,TEXT,MAX) ; EP -- LOOKUP PATIENTS
  1.  ;
  1.  ;Description - Find a list of patients based on search criteria
  1.  ;Input
  1.  ;  TEXT - Search text which can include name, SSN, HRN, etc.
  1.  ;   MAX - Maximum results to return
  1.  ;Output
  1.  ;  BEDD - Array of patients
  1.  ;
  1.  NEW UID,I,H,FILE,FIELD,XREF,FLAGS,NUMB,SCREEN,BN,DFN,NAME,HRN
  1.  NEW DOB,DOD,AL,ALFLG,X,ALIAS,NODE,RCNT,TYPE,X,SEX,DISP,TMP
  1.  ;
  1.  ; NOTE: Since "DILIST" is used by the DIC calls it must use $J and not UID.
  1.  K BEDD,^TMP("DILIST",$J)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BEDDPLKP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S TYPE=""
  1.  S MAX=+$G(MAX) S:MAX=0 MAX=25
  1.  ;
  1.  ;DOB lookup
  1.  I $$DATE(TEXT)]"" D
  1.  . S TYPE="D"
  1.  . S TEXT=$$DATE(TEXT)
  1.  . S FILE=2,FIELD=.03,XREF="ADOB",FLAGS="P",NUMB="*"
  1.  . D LKUP
  1.  ;
  1.  ;HRN lookup
  1.  I $O(^TMP("DILIST",$J,0))="",$L(TEXT),((TEXT?1.9N)!(TEXT?1"T"5N)) D
  1.  . NEW BN,DFN,LOC
  1.  . S TYPE="H"
  1.  . S BN=0,DFN=""
  1.  . F  S DFN=$O(^AUPNPAT("D",TEXT,DFN)) Q:DFN=""  D
  1.  .. S LOC=0
  1.  .. F  S LOC=$O(^AUPNPAT(DFN,41,LOC)) Q:'LOC  D
  1.  ... I $P($G(^AUPNPAT(DFN,41,LOC,0)),U,3)'="" Q
  1.  ... I $P($G(^AUPNPAT(DFN,41,LOC,0)),U,2)'=TEXT Q
  1.  ... S BN=BN+1,$P(^TMP("DILIST",$J,BN,0),"^",1)=DFN
  1.  ... S $P(^TMP("DILIST",$J,BN,0),"^",2)=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  ;
  1.  ;SSN L4 lookup
  1.  I TYPE="",$L(TEXT)=5,TEXT?1A4N D
  1.  . S TYPE="S4"
  1.  . S FILE=2,FIELD=.09,XREF="BS5",FLAGS="P",NUMB="*"
  1.  . D LKUP
  1.  ;
  1.  ; If user enter spaces after comma, strip extraneous spaces
  1.  I TYPE="" D
  1.  . S TEXT=$$REMDBL^XLFNAME1(TEXT," ")
  1.  . ;
  1.  . ;if no type of search was passed, the lookup will have to be through all cross-references
  1.  . ; Change text to all uppercase
  1.  . S TEXT=$$UP^XLFSTR(TEXT)
  1.  . S FILE=9000001,FIELD=".01",XREF="",FLAGS="MP",NUMB="*"
  1.  . D LKUP
  1.  ;
  1.  ; For each patient found in the search, get the list data
  1.  S BN=0 F  S BN=$O(^TMP("DILIST",$J,BN)) Q:'BN  D
  1.  . S DFN=$P(^TMP("DILIST",$J,BN,0),"^",1)
  1.  . ;
  1.  . ;Filter results on location
  1.  . Q:'$D(^AUPNPAT(DFN,41,DUZ(2),0))
  1.  . ;
  1.  . S NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  . S SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
  1.  . S HRN=$$HRNL(DFN) Q:HRN=""
  1.  . S DOB=$$FMTE^BEDDUTIL($$GET1^DIQ(2,DFN_",",.03,"I"))
  1.  . S DOD=$$FMTE^BEDDUTIL($$GET1^DIQ(2,DFN_",",.351,"I"))
  1.  . S AL=0,ALFLG="N" D
  1.  .. S AL=$O(^DPT(DFN,.01,AL)) Q:'AL  S ALFLG="Y"
  1.  . S ALIAS="" I TYPE'="H",TYPE'="S4",TEXT?1A.E,$E(NAME,1,$L(TEXT))'=TEXT S ALIAS=$$ALIAS(DFN,TEXT) I 'ALIAS Q
  1.  . I ALIAS S DISP=$P(ALIAS,U,2)_" ["_NAME_"] "
  1.  . E  S DISP=NAME
  1.  . S NODE=DISP_"^"_DFN
  1.  . S DISP=DISP_" ("_SEX_") - DOB: "_DOB_" "_$S(HRN]"":"HRN: ",1:"")
  1.  . F I=1:1:$L(HRN,";") S H=$P(HRN,";",I) I H]"" Q:($L(DISP_H)>85)  S DISP=DISP_$S(I>1:";",1:"")_H
  1.  . S TMP(NODE)=DFN_U_DISP
  1.  ;
  1.  ;Limit Results to Maximum Requested
  1.  S RCNT=0,NODE="" F  S NODE=$O(TMP(NODE)) Q:(NODE="")!(RCNT'<MAX)  S RCNT=RCNT+1,BEDD(RCNT)=TMP(NODE)
  1.  ;
  1. DONE ;
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. LKUP ;
  1.  NEW DIQUIET
  1.  S DIQUIET=1
  1.  S:FIELD]"" FIELD=FIELD_";@"
  1.  D FIND^DIC(FILE,"",FIELD,FLAGS,TEXT,"",XREF,$G(SCREEN),"","","ERROR")
  1.  Q
  1.  ;
  1. ALIAS(PTIEN,TEXT) ;EP
  1.  ; Does this patient's alias match the TEXT?
  1.  N IEN,ALIAS,ALFND
  1.  S IEN=0,ALFND=""
  1.  F  S IEN=$O(^DPT(PTIEN,.01,IEN)) Q:'IEN!ALFND  D
  1.  . S ALIAS=$$GET1^DIQ(2.01,IEN_","_PTIEN_",",.01,"E")
  1.  . I $E(ALIAS,1,$L(TEXT))=TEXT S ALFND="1^"_ALIAS
  1.  Q ALFND
  1.  ;
  1. DATE(DATE) ;EP - Convert standard date/time to a FileMan date/time
  1.  ;Input
  1.  ;  DATE - In a standard format
  1.  ;Output
  1.  ;  -1 is if it couldn't convert to a FileMan date
  1.  ;  otherwise a standard FileMan date
  1.  NEW %DT,X,Y
  1.  I DATE[":" D
  1.  . I DATE["/",$L(DATE," ")=3 S DATE=$P(DATE," ",1)_"@"_$P(DATE," ",2)_$P(DATE," ",3) Q
  1.  . I $L(DATE," ")=3 S DATE=$P(DATE," ",1,2)_"@"_$P(DATE," ",3)
  1.  . I $L(DATE," ")>3 S DATE=$P(DATE," ",1,3)_"@"_$P(DATE," ",4,99)
  1.  S %DT="TS",X=DATE D ^%DT
  1.  I Y=-1 S Y=""
  1.  ;
  1.  Q Y
  1.  ;
  1. SENS(DFN) ;EP -- Is patient sensitive flag
  1.  ;Input
  1.  ;  DFN - Patient internal entry number
  1.  NEW FLAG
  1.  S FLAG=+$P($G(^DGSL(38.1,+DFN,0)),"^",2)
  1.  S FLAG=$S(FLAG=1:"Y",1:"N")
  1.  Q FLAG
  1.  ;
  1. HRNL(DFN) ;EP -- List of HRNs for a patient
  1.  NEW HRN,LOC,HDATA,ABR,VAL,ULOC
  1.  S LOC=0,VAL=""
  1.  S VAL=$$HLK(DUZ(2))
  1.  Q $$TKO(VAL,";")
  1.  ;
  1. HLK(ULOC) ; EP - Get HRN data for a location
  1.  NEW HDATA,IACT
  1.  S HDATA=$G(^AUPNPAT(DFN,41,ULOC,0))
  1.  S HRN=$P(HDATA,U,2),IACT=$P(HDATA,U,3)
  1.  I HRN="" Q ""
  1.  I IACT'="" S HRN=""  ;Inactive patient
  1.  Q HRN
  1.  ;
  1. TKO(STR,VAL) ;EP - Take off ending character
  1.  ;
  1.  ;Description
  1.  ;  This will take off the ending character at the end of
  1.  ;  a string
  1.  ;Input
  1.  ;  STR - String of data
  1.  ;  VAL - Delimiter character
  1.  ;Output
  1.  ;  same STR without the ending character
  1.  ;
  1.  I $G(STR)="" Q ""
  1.  I $G(VAL)="" Q ""
  1.  ;
  1.  NEW LV
  1.  S LV=$L(VAL)
  1.  I $E(STR,$L(STR)-(LV-1),$L(STR))=VAL S STR=$E(STR,1,$L(STR)-LV)
  1.  ;
  1.  Q STR
  1.  ;
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  Q