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

BQIPTLKP.m

Go to the documentation of this file. 
  1. BQIPTLKP ;PRXM/HC/ALA-Patient Lookup ; 29 Oct 2005  6:51 PM
  1.  ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
  1.  ;
  1.  Q
  1.  ;
  1. FND(DATA,TEXT,TYPE) ; EP -- BQI 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.  ;  TYPE - Search type, a code indicating which type of search
  1.  ;Output
  1.  ;  DATA
  1.  ;
  1.  NEW UID,II,FILE,FIELD,XREF,FLAGS,NUMB,SCREEN,BN,DFN,NAME,HRN
  1.  NEW DOB,DOD,AL,ALFLG,X,SSN,SENS,ALIAS,NODE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIPTLK",UID))
  1.  ; NOTE: Since "DILIST" is used by the DIC calls it must use $J and not UID.
  1.  K @DATA,^TMP("DILIST",$J)
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTLKP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S TYPE=$G(TYPE,"")
  1.  ; determine if the data text is in a date format that can be converted to
  1.  ; FileMan date, then this is probably a date of birth search
  1.  I $L(TEXT),$L(TEXT)<7,TEXT'?6AP S TYPE="H"
  1.  I TEXT?1A.AN S TYPE=""
  1.  I $L(TEXT)=5,TEXT?1A4N S TYPE="S4"
  1.  I $$DATE^BQIUL1(TEXT)'="",$L(TEXT)>6 S TEXT=$$DATE^BQIUL1(TEXT),TYPE="D"
  1.  ; If user enter spaces after comma, strip extraneous spaces
  1.  S TEXT=$$REMDBL^XLFNAME1(TEXT," ")
  1.  I TEXT?.E1", ".E D
  1.  . S TEXT=$P(TEXT,", ")_","_$P(TEXT,", ",2,999)
  1.  ;
  1.  S @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00015HRN^T00009SSN^D00030DOB^D00030DOD^T00001ALIAS_FLAG^T00001SENS_FLAG"_$C(30)
  1.  ;
  1.  ;  if no type of search was passed, the lookup will have to be through all cross-references
  1.  I TYPE="" D
  1.  . ; Change text to all uppercase
  1.  . S TEXT=$$UP^XLFSTR(TEXT)
  1.  . S FILE=9000001,FIELD=".01",XREF="",FLAGS="MP",NUMB="*" ; Changed from "CMP" to "MP"
  1.  . ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
  1.  . D LKUP
  1.  ;
  1.  ;  if the type is 'N', lookup only in the patient name cross-reference
  1.  I TYPE="N" D
  1.  . S FILE=2,FIELD=.01,XREF="B",FLAGS="P",NUMB="*" ; Changed from "CP" to "P"
  1.  . ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
  1.  . D LKUP
  1.  ;
  1.  ;  if the type is 'S', lookup only in the social security cross-reference
  1.  I TYPE="S" D
  1.  . S FILE=2,FIELD=.09,XREF="SSN",FLAGS="P",NUMB="*"
  1.  . ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
  1.  . D LKUP
  1.  ;
  1.  I TYPE="S4" D
  1.  . S FILE=2,FIELD=.09,XREF="BS5",FLAGS="P",NUMB="*"
  1.  . D LKUP
  1.  ;
  1.  ;  if the type is 'D', lookup only in the date of birth cross-reference
  1.  I TYPE="D" D
  1.  . S FILE=2,FIELD=.03,XREF="ADOB",FLAGS="P",NUMB="*"
  1.  . ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
  1.  . D LKUP
  1.  ;
  1.  ;  if the type is 'H', lookup only in the health record number cross-reference
  1.  I TYPE="H" D
  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.  ; 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.  . S NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
  1.  . S HRN=$$HRNL^BQIULPT(DFN),SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
  1.  . I '$D(^XUSEC("AGZVIEWSSN",DUZ)),SSN'["P",SSN'="" S SSN="XXX-XX-"_$E(SSN,6,9)
  1.  . S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
  1.  . S DOD=$$FMTE^BQIUL1($$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 SENS=$$SENS^BQIULPT(DFN)
  1.  . S ALIAS=""
  1.  . ; Are we displaying an alias?
  1.  . ; If there's no match on the patient's name and it isn't an alias it's a bad cross reference
  1.  . ; If this is an alias it should sort after name matches (add one million to counter)
  1.  . I TYPE'="H",TYPE'="S4",TEXT?1A.E,$E(NAME,1,$L(TEXT))'=TEXT S ALIAS=$$ALIAS(DFN,TEXT) I 'ALIAS Q
  1.  . S II=II+1,NODE=$S(ALIAS:1000000+II,1:II)
  1.  . S @DATA@(NODE)=DFN_"^"_NAME_"^"_HRN_"^"_SSN_"^"_DOB_"^"_DOD_"^"_ALFLG_"^"_SENS_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(1000000+II)=$C(31)
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. LKUP ;
  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
  1.  Q ALFND
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(1000000+II)=$C(31)
  1.  Q