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

AGGPTLKP.m

Go to the documentation of this file. 
  1. AGGPTLKP ;VNGT/HS/ALA-Patient Lookup ; 14 Apr 2010  6:58 AM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. FND(DATA,TEXT,TYPE,ALL,INAC) ; EP -- AGG 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.  ;  ALL  - If blank, search by users division, if '1' search all divisions
  1.  ;  INAC - If blank, exclude inactive patients, if '1' include inactive patients
  1.  ;Output
  1.  ;  DATA
  1.  ;
  1.  NEW UID,II,FILE,FIELD,XREF,FLAGS,NUMB,SCREEN,BN,DFN,NAME,HRN,COMM,AQ
  1.  NEW DOB,DOD,AL,ALFLG,X,SSN,SENS,ALIAS,NODE,DEC,ZZ,TXT,PDATA,HDR,MOMDN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPTLK",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^AGGPTLKP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S TYPE=$G(TYPE,"")
  1.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ; Check to include deceased patients in search
  1.  S DEC=$P($G(^AGFAC(DUZ(2),0)),U,12)
  1.  I TEXT[$C(28) D  G DONE
  1.  . K ZZ
  1.  . F AQ=1:1:$L(TEXT,$C(28)) D
  1.  .. S PDATA=$P(TEXT,$C(28),AQ) Q:PDATA=""
  1.  .. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  .. D FULL(NAME,VALUE)
  1.  .. S @NAME=VALUE
  1.  . I $D(NARRAY) S PTNAME=$$F^XLFNAME1(.NARRAY,"C")
  1.  . I $G(PTNAME)'="" S TEXT=PTNAME,TYPE="N" D @TYPE,LST2
  1.  . I $G(AGGPTSSN)'="" S TEXT=AGGPTSSN,TYPE="S" D @TYPE,LST2
  1.  . I $G(AGGPTDOB)'="" S TYPE="D",AGGPTDOB=$$DATE^AGGUL1(AGGPTDOB),TEXT=AGGPTDOB D @TYPE,LST2
  1.  . K NARRAY,PTNAME,AGGPTSSN,AGGPTDOB,AGGPTFNM,AGGPTMNM,AGGPTLNM,AGGPTSFX
  1.  . S AQ="" F  S AQ=$O(ZZ(AQ)) Q:AQ=""  S II=II+1,@DATA@(II)=ZZ(AQ)
  1.  . K ZZ
  1.  ;
  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 $$DATE^AGGUL1(TEXT)'="",$L(TEXT)>6 S TEXT=$$DATE^AGGUL1(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.  I TYPE'="" D @TYPE D LST G DONE
  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=2,FIELD=".01",XREF="",FLAGS="CMP",NUMB="*" ; Changed from "MP" to "CMP"
  1.  . ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
  1.  . I $G(ALL)="" S SCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0)),$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)=""""",1:"")
  1.  . I $G(ALL)'="" S SCREEN=""
  1.  . I $G(INAC)'="" S SCREEN=$S(+DUZ(2):"I $G(^AUPNPAT(Y,41,DUZ(2),0))'=""""",1:"")
  1.  . D LKUP
  1.  D LST
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  K ^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. N ;  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.  . I $G(ALL)="" S SCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0)),$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)=""""",1:"")
  1.  . I $G(ALL)'="" S SCREEN="",FLAGS="CP"
  1.  . D LKUP
  1.  Q
  1.  ;
  1. S ;  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.  . I $G(ALL)="" S SCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0)),$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)=""""",1:"")
  1.  . I $G(ALL)'="" S SCREEN=""
  1.  . D LKUP
  1.  Q
  1.  ;
  1. D ;  if the type is 'D', lookup only in the date of birth cross-reference
  1.  I TYPE="D" D
  1.  . S FILE=2,FIELD="",XREF="ADOB",FLAGS="P",NUMB="*"
  1.  . ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
  1.  . I $G(ALL)="" S SCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0)),$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)=""""",1:"")
  1.  . I $G(ALL)'="" S SCREEN=""
  1.  . D LKUP
  1.  Q
  1.  ;
  1. H ;  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.  Q
  1.  ;
  1. LST ; 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=$$HRN^AGGUL1(DFN),INACTIVE="N"
  1.  . I $G(INAC)'="",HRN["*" S INACTIVE="Y"
  1.  . I $G(ALL)=1 S HRN=$$HRNL^AGGUL2(DFN)
  1.  . S SSN=$P(^DPT(DFN,0),U,9)
  1.  . I '$D(^XUSEC("AGZVIEWSSN",DUZ)),SSN'["P",$G(ALL)'=1,SSN'="" S SSN="XXX-XX-"_$E(SSN,6,9)
  1.  . S DOB=$$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
  1.  . S DOD=$$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.351,"I"))
  1.  . ; if Date of Death and DECEASED PATIENTS in look-ups field is not YES, quit
  1.  . I DEC'="Y",DOD'="" Q
  1.  . S SENS=$E($$SENS^AGGUL1(DFN),1,1)
  1.  . I $P($G(^AGFAC(DUZ(2),0)),U,11)="Y" S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"E"),MOMDN=$$GET1^DIQ(2,DFN_",",.2403,"E")
  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",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 ALIAS=$$ALLST(DFN)
  1.  . S II=II+1
  1.  . I $P($G(^AGFAC(DUZ(2),0)),U,11)="Y",$G(ALL)=1 S @DATA@(II)=DFN_U_NAME_U_HRN_U_SSN_U_DOB_U_DOD_U_SENS_U_ALIAS_U_INACTIVE_U_COMM_U_MOMDN_$C(30) Q
  1.  . S @DATA@(II)=DFN_U_NAME_U_HRN_U_SSN_U_DOB_U_DOD_U_SENS_U_ALIAS_U_INACTIVE_$C(30)
  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. ALLST(PTIEN) ;EP - List of Aliases
  1.  NEW IEN,ALIAS,ANAM
  1.  S ALIAS=""
  1.  S IEN=0
  1.  F  S IEN=$O(^DPT(PTIEN,.01,IEN)) Q:'IEN  D
  1.  . S ANAM=$$GET1^DIQ(2.01,IEN_","_PTIEN_",",.01,"E")
  1.  . S ALIAS=ALIAS_ANAM_"; "
  1.  Q $$TKO^AGGUL1(ALIAS,"; ")
  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@(II)=$C(31)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S HDR="I00010DFN^T00030PATIENT_NAME^T00030HRN^T00009SSN^D00030DOB^D00030DOD^T00003SENS_FLAG^T01024ALIAS^T00001INACTIVE"
  1.  I $P($G(^AGFAC(DUZ(2),0)),U,11)="Y",$G(ALL)=1 S HDR=HDR_"^T00030COMM^T00030MOMDN"
  1.  Q
  1.  ;
  1. FULL(NAME,VALUE) ; Full Name
  1.  I NAME="AGGPTLNM" S NARRAY("FAMILY")=VALUE
  1.  I NAME="AGGPTFNM" S NARRAY("GIVEN")=VALUE
  1.  I NAME="AGGPTMNM" S NARRAY("MIDDLE")=VALUE
  1.  I NAME="AGGPTSFX" S NARRAY("SUFFIX")=VALUE
  1.  F TXT="FAMILY","GIVEN","MIDDLE","SUFFIX" I $G(NARRAY(TXT))="" S NARRAY(TXT)=""
  1.  Q
  1.  ;
  1. LST2 ; 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=$$HRN^AGGUL1(DFN),INACTIVE="N"
  1.  . I $G(INAC)'="",HRN["*" S INACTIVE="Y"
  1.  . I $G(ALL)=1 S HRN=$$HRNL^AGGUL2(DFN)
  1.  . S SSN=$P(^DPT(DFN,0),U,9)
  1.  . I '$D(^XUSEC("AGZVIEWSSN",DUZ)),SSN'["P",$G(ALL)'=1 S SSN="XXX-XX-"_$E(SSN,6,9)
  1.  . S DOB=$$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
  1.  . S DOD=$$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.351,"I"))
  1.  . ; if Date of Death and DECEASED PATIENTS in look-ups field is not YES, quit
  1.  . I DEC'="Y",DOD'="" Q
  1.  . S SENS=$$SENS^AGGUL1(DFN)
  1.  . I $P($G(^AGFAC(DUZ(2),0)),U,11)="Y" S COMM=$$GET1^DIQ(9000001,DFN_",",1117,"E"),MOMDN=$$GET1^DIQ(2,DFN_",",.2403,"E")
  1.  . S ALIAS=$$ALLST(DFN)
  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",TEXT?1A.E,$E(NAME,1,$L(TEXT))'=TEXT S ALIAS=$$ALIAS(DFN,TEXT) I 'ALIAS Q
  1.  . S ZZ(DFN)=""
  1.  . I $P($G(^AGFAC(DUZ(2),0)),U,11)="Y",$G(ALL)=1 S ZZ(DFN)=DFN_"^"_NAME_"^"_HRN_"^"_SSN_"^"_DOB_"^"_DOD_"^"_SENS_"^"_ALIAS_"^"_INACTIVE_"^"_COMM_"^"_MOMDN_$C(30) Q
  1.  . S ZZ(DFN)=DFN_"^"_NAME_"^"_HRN_"^"_SSN_"^"_DOB_"^"_DOD_"^"_SENS_"^"_ALIAS_"^"_INACTIVE_$C(30)
  1.  Q