BQIPTLKP ;PRXM/HC/ALA-Patient Lookup ; 29 Oct 2005 6:51 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
;
Q
;
FND(DATA,TEXT,TYPE) ; EP -- BQI LOOKUP PATIENTS
;
;Description - Find a list of patients based on search criteria
;Input
; TEXT - Search text which can include name, SSN, HRN, etc.
; TYPE - Search type, a code indicating which type of search
;Output
; DATA
;
NEW UID,II,FILE,FIELD,XREF,FLAGS,NUMB,SCREEN,BN,DFN,NAME,HRN
NEW DOB,DOD,AL,ALFLG,X,SSN,SENS,ALIAS,NODE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTLK",UID))
; NOTE: Since "DILIST" is used by the DIC calls it must use $J and not UID.
K @DATA,^TMP("DILIST",$J)
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTLKP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S TYPE=$G(TYPE,"")
; determine if the data text is in a date format that can be converted to
; FileMan date, then this is probably a date of birth search
I $L(TEXT),$L(TEXT)<7,TEXT'?6AP S TYPE="H"
I TEXT?1A.AN S TYPE=""
I $L(TEXT)=5,TEXT?1A4N S TYPE="S4"
I $$DATE^BQIUL1(TEXT)'="",$L(TEXT)>6 S TEXT=$$DATE^BQIUL1(TEXT),TYPE="D"
; If user enter spaces after comma, strip extraneous spaces
S TEXT=$$REMDBL^XLFNAME1(TEXT," ")
I TEXT?.E1", ".E D
. S TEXT=$P(TEXT,", ")_","_$P(TEXT,", ",2,999)
;
S @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00015HRN^T00009SSN^D00030DOB^D00030DOD^T00001ALIAS_FLAG^T00001SENS_FLAG"_$C(30)
;
; if no type of search was passed, the lookup will have to be through all cross-references
I TYPE="" D
. ; Change text to all uppercase
. S TEXT=$$UP^XLFSTR(TEXT)
. S FILE=9000001,FIELD=".01",XREF="",FLAGS="MP",NUMB="*" ; Changed from "CMP" to "MP"
. ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
. D LKUP
;
; if the type is 'N', lookup only in the patient name cross-reference
I TYPE="N" D
. S FILE=2,FIELD=.01,XREF="B",FLAGS="P",NUMB="*" ; Changed from "CP" to "P"
. ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
. D LKUP
;
; if the type is 'S', lookup only in the social security cross-reference
I TYPE="S" D
. S FILE=2,FIELD=.09,XREF="SSN",FLAGS="P",NUMB="*"
. ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
. D LKUP
;
I TYPE="S4" D
. S FILE=2,FIELD=.09,XREF="BS5",FLAGS="P",NUMB="*"
. D LKUP
;
; if the type is 'D', lookup only in the date of birth cross-reference
I TYPE="D" D
. S FILE=2,FIELD=.03,XREF="ADOB",FLAGS="P",NUMB="*"
. ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
. D LKUP
;
; if the type is 'H', lookup only in the health record number cross-reference
I TYPE="H" D
. S BN=0,DFN=""
. F S DFN=$O(^AUPNPAT("D",TEXT,DFN)) Q:DFN="" D
.. S LOC=0
.. F S LOC=$O(^AUPNPAT(DFN,41,LOC)) Q:'LOC D
... I $P($G(^AUPNPAT(DFN,41,LOC,0)),U,3)'="" Q
... I $P($G(^AUPNPAT(DFN,41,LOC,0)),U,2)'=TEXT Q
... S BN=BN+1,$P(^TMP("DILIST",$J,BN,0),"^",1)=DFN
... S $P(^TMP("DILIST",$J,BN,0),"^",2)=$$GET1^DIQ(9000001,DFN_",",.01,"E")
;
; For each patient found in the search, get the list data
S BN=0 F S BN=$O(^TMP("DILIST",$J,BN)) Q:'BN D
. S DFN=$P(^TMP("DILIST",$J,BN,0),"^",1)
. S NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
. S HRN=$$HRNL^BQIULPT(DFN),SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
. I '$D(^XUSEC("AGZVIEWSSN",DUZ)),SSN'["P",SSN'="" S SSN="XXX-XX-"_$E(SSN,6,9)
. S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
. S DOD=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.351,"I"))
. S AL=0,ALFLG="N" D
.. S AL=$O(^DPT(DFN,.01,AL)) Q:'AL S ALFLG="Y"
. S SENS=$$SENS^BQIULPT(DFN)
. S ALIAS=""
. ; Are we displaying an alias?
. ; If there's no match on the patient's name and it isn't an alias it's a bad cross reference
. ; If this is an alias it should sort after name matches (add one million to counter)
. I TYPE'="H",TYPE'="S4",TEXT?1A.E,$E(NAME,1,$L(TEXT))'=TEXT S ALIAS=$$ALIAS(DFN,TEXT) I 'ALIAS Q
. S II=II+1,NODE=$S(ALIAS:1000000+II,1:II)
. S @DATA@(NODE)=DFN_"^"_NAME_"^"_HRN_"^"_SSN_"^"_DOB_"^"_DOD_"^"_ALFLG_"^"_SENS_$C(30)
;
DONE ;
S II=II+1,@DATA@(1000000+II)=$C(31)
K ^TMP("DILIST",$J)
Q
;
LKUP ;
D FIND^DIC(FILE,"",FIELD,FLAGS,TEXT,"",XREF,$G(SCREEN),"","","ERROR")
Q
;
ALIAS(PTIEN,TEXT) ;EP
; Does this patient's alias match the TEXT?
N IEN,ALIAS,ALFND
S IEN=0,ALFND=""
F S IEN=$O(^DPT(PTIEN,.01,IEN)) Q:'IEN!ALFND D
. S ALIAS=$$GET1^DIQ(2.01,IEN_","_PTIEN_",",.01,"E")
. I $E(ALIAS,1,$L(TEXT))=TEXT S ALFND=1
Q ALFND
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(1000000+II)=$C(31)
Q
BQIPTLKP ;PRXM/HC/ALA-Patient Lookup ; 29 Oct 2005 6:51 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
+2 ;
+3 QUIT
+4 ;
FND(DATA,TEXT,TYPE) ; EP -- BQI LOOKUP PATIENTS
+1 ;
+2 ;Description - Find a list of patients based on search criteria
+3 ;Input
+4 ; TEXT - Search text which can include name, SSN, HRN, etc.
+5 ; TYPE - Search type, a code indicating which type of search
+6 ;Output
+7 ; DATA
+8 ;
+9 NEW UID,II,FILE,FIELD,XREF,FLAGS,NUMB,SCREEN,BN,DFN,NAME,HRN
+10 NEW DOB,DOD,AL,ALFLG,X,SSN,SENS,ALIAS,NODE
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+12 SET DATA=$NAME(^TMP("BQIPTLK",UID))
+13 ; NOTE: Since "DILIST" is used by the DIC calls it must use $J and not UID.
+14 KILL @DATA,^TMP("DILIST",$JOB)
+15 ;
+16 SET II=0
+17 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTLKP D UNWIND^%ZTER"
+18 ;
+19 SET TYPE=$GET(TYPE,"")
+20 ; determine if the data text is in a date format that can be converted to
+21 ; FileMan date, then this is probably a date of birth search
+22 IF $LENGTH(TEXT)
IF $LENGTH(TEXT)<7
IF TEXT'?6AP
SET TYPE="H"
+23 IF TEXT?1A.AN
SET TYPE=""
+24 IF $LENGTH(TEXT)=5
IF TEXT?1A4N
SET TYPE="S4"
+25 IF $$DATE^BQIUL1(TEXT)'=""
IF $LENGTH(TEXT)>6
SET TEXT=$$DATE^BQIUL1(TEXT)
SET TYPE="D"
+26 ; If user enter spaces after comma, strip extraneous spaces
+27 SET TEXT=$$REMDBL^XLFNAME1(TEXT," ")
+28 IF TEXT?.E1", ".E
Begin DoDot:1
+29 SET TEXT=$PIECE(TEXT,", ")_","_$PIECE(TEXT,", ",2,999)
End DoDot:1
+30 ;
+31 SET @DATA@(II)="I00010DFN^T00030PATIENT_NAME^T00015HRN^T00009SSN^D00030DOB^D00030DOD^T00001ALIAS_FLAG^T00001SENS_FLAG"_$CHAR(30)
+32 ;
+33 ; if no type of search was passed, the lookup will have to be through all cross-references
+34 IF TYPE=""
Begin DoDot:1
+35 ; Change text to all uppercase
+36 SET TEXT=$$UP^XLFSTR(TEXT)
+37 ; Changed from "CMP" to "MP"
SET FILE=9000001
SET FIELD=".01"
SET XREF=""
SET FLAGS="MP"
SET NUMB="*"
+38 ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
+39 DO LKUP
End DoDot:1
+40 ;
+41 ; if the type is 'N', lookup only in the patient name cross-reference
+42 IF TYPE="N"
Begin DoDot:1
+43 ; Changed from "CP" to "P"
SET FILE=2
SET FIELD=.01
SET XREF="B"
SET FLAGS="P"
SET NUMB="*"
+44 ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
+45 DO LKUP
End DoDot:1
+46 ;
+47 ; if the type is 'S', lookup only in the social security cross-reference
+48 IF TYPE="S"
Begin DoDot:1
+49 SET FILE=2
SET FIELD=.09
SET XREF="SSN"
SET FLAGS="P"
SET NUMB="*"
+50 ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
+51 DO LKUP
End DoDot:1
+52 ;
+53 IF TYPE="S4"
Begin DoDot:1
+54 SET FILE=2
SET FIELD=.09
SET XREF="BS5"
SET FLAGS="P"
SET NUMB="*"
+55 DO LKUP
End DoDot:1
+56 ;
+57 ; if the type is 'D', lookup only in the date of birth cross-reference
+58 IF TYPE="D"
Begin DoDot:1
+59 SET FILE=2
SET FIELD=.03
SET XREF="ADOB"
SET FLAGS="P"
SET NUMB="*"
+60 ;S SCREEN=$S(+DUZ(2):"I '$P($G(^AUPNPAT(Y,41,DUZ(2),0)),U,3)",1:"")
+61 DO LKUP
End DoDot:1
+62 ;
+63 ; if the type is 'H', lookup only in the health record number cross-reference
+64 IF TYPE="H"
Begin DoDot:1
+65 SET BN=0
SET DFN=""
+66 FOR
SET DFN=$ORDER(^AUPNPAT("D",TEXT,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+67 SET LOC=0
+68 FOR
SET LOC=$ORDER(^AUPNPAT(DFN,41,LOC))
IF 'LOC
QUIT
Begin DoDot:3
+69 IF $PIECE($GET(^AUPNPAT(DFN,41,LOC,0)),U,3)'=""
QUIT
+70 IF $PIECE($GET(^AUPNPAT(DFN,41,LOC,0)),U,2)'=TEXT
QUIT
+71 SET BN=BN+1
SET $PIECE(^TMP("DILIST",$JOB,BN,0),"^",1)=DFN
+72 SET $PIECE(^TMP("DILIST",$JOB,BN,0),"^",2)=$$GET1^DIQ(9000001,DFN_",",.01,"E")
End DoDot:3
End DoDot:2
End DoDot:1
+73 ;
+74 ; For each patient found in the search, get the list data
+75 SET BN=0
FOR
SET BN=$ORDER(^TMP("DILIST",$JOB,BN))
IF 'BN
QUIT
Begin DoDot:1
+76 SET DFN=$PIECE(^TMP("DILIST",$JOB,BN,0),"^",1)
+77 SET NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
+78 SET HRN=$$HRNL^BQIULPT(DFN)
SET SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
+79 IF '$DATA(^XUSEC("AGZVIEWSSN",DUZ))
IF SSN'["P"
IF SSN'=""
SET SSN="XXX-XX-"_$EXTRACT(SSN,6,9)
+80 SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+81 SET DOD=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.351,"I"))
+82 SET AL=0
SET ALFLG="N"
Begin DoDot:2
+83 SET AL=$ORDER(^DPT(DFN,.01,AL))
IF 'AL
QUIT
SET ALFLG="Y"
End DoDot:2
+84 SET SENS=$$SENS^BQIULPT(DFN)
+85 SET ALIAS=""
+86 ; Are we displaying an alias?
+87 ; If there's no match on the patient's name and it isn't an alias it's a bad cross reference
+88 ; If this is an alias it should sort after name matches (add one million to counter)
+89 IF TYPE'="H"
IF TYPE'="S4"
IF TEXT?1A.E
IF $EXTRACT(NAME,1,$LENGTH(TEXT))'=TEXT
SET ALIAS=$$ALIAS(DFN,TEXT)
IF 'ALIAS
QUIT
+90 SET II=II+1
SET NODE=$SELECT(ALIAS:1000000+II,1:II)
+91 SET @DATA@(NODE)=DFN_"^"_NAME_"^"_HRN_"^"_SSN_"^"_DOB_"^"_DOD_"^"_ALFLG_"^"_SENS_$CHAR(30)
End DoDot:1
+92 ;
DONE ;
+1 SET II=II+1
SET @DATA@(1000000+II)=$CHAR(31)
+2 KILL ^TMP("DILIST",$JOB)
+3 QUIT
+4 ;
LKUP ;
+1 DO FIND^DIC(FILE,"",FIELD,FLAGS,TEXT,"",XREF,$GET(SCREEN),"","","ERROR")
+2 QUIT
+3 ;
ALIAS(PTIEN,TEXT) ;EP
+1 ; Does this patient's alias match the TEXT?
+2 NEW IEN,ALIAS,ALFND
+3 SET IEN=0
SET ALFND=""
+4 FOR
SET IEN=$ORDER(^DPT(PTIEN,.01,IEN))
IF 'IEN!ALFND
QUIT
Begin DoDot:1
+5 SET ALIAS=$$GET1^DIQ(2.01,IEN_","_PTIEN_",",.01,"E")
+6 IF $EXTRACT(ALIAS,1,$LENGTH(TEXT))=TEXT
SET ALFND=1
End DoDot:1
+7 QUIT ALFND
+8 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(1000000+II)=$CHAR(31)
+6 QUIT
