AMERLKP ;GDIT/HS/ALA-Patient Lookup ; 16 Oct 2013 7:49 AM
;;3.0;ER VISIT SYSTEM;**5**;MAR 03, 2009;Build 14
;
SCAN ;EP
;
NEW DIR,X,Y,TEXT,TYPE,II,BN,QFL,%H,%I
;
S DIR("A")="Enter patient NAME, DOB, or LOCAL CHART NUMBER"
S DIR(0)="F^3:30"
D ^DIR
;
;NOTE: Since "DILIST" is used by the DIC calls it must use $J and not UID.
K ^TMP("DILIST",$J)
S TEXT=Y
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AMERLKP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S TYPE=""
;
;Look for a DOB
I $$DATE(TEXT)'="" S TEXT=$$DATE(TEXT),TYPE="D"
;
;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
. NEW FILE,FIELD,XREF,FLAGS
. S TEXT=$$UP^XLFSTR(TEXT)
. S FILE=9000001,FIELD=".01",XREF="",FLAGS="PM"
. D LKUP
;
;If the type is 'D', do a date of birth lookup
I TYPE="D" D
. S FILE=2,FIELD=.03,XREF="ADOB",FLAGS="P"
. D LKUP
;
; For each patient found in the search, get the list data
S BN=0,QFL=0,II=0
F S BN=$O(^TMP("DILIST",$J,BN)) Q:'BN D Q:(QFL'=0)
. NEW DFN,NAME,AUPDICW,ALIAS,AMXX,DIC
. S DFN=$P(^TMP("DILIST",$J,BN,0),"^",1)
. S NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
. S AUPDICW="D IHSDUPE^AUPNLKID D ^AUPNLKID"
. S Y=DFN,II=II+1
. ;
. ;Perform audit log call
. D LOG^AMERBUSA("P","Q","AMERLKP","AMER: Scan Patient Names or Chart Numbers",DFN)
. ;
. ;Display the patient information
. I TEXT?1A.E,$E(NAME,1,$L(TEXT))'=TEXT S ALIAS=$$ALIAS(DFN,TEXT)
. S AMXX=^DPT(DFN,0),DIC="^DPT("
. W !,II_". "_$S($G(ALIAS)'="":ALIAS_" "_NAME,1:NAME) X AUPDICW
. I II#5=0 S QFL=$$ASK(II)
;
;Display the item
I QFL>0 D
. NEW DFN,NAME,AMXX,Y,AUPDICW,DIC,DIR,X,Y
. S DFN=$P(^TMP("DILIST",$J,QFL,0),U,1),NAME=$P(^DPT(DFN,0),U,1)
. S AMXX=^DPT(DFN,0),DIC="^DPT(",Y=DFN
. S AUPDICW="D IHSDUPE^AUPNLKID D ^AUPNLKID"
. W !!,NAME X AUPDICW
;
;Display prompt to continue
W !! S DIR(0)="E",DIR("A")="Press 'Return to continue"
D ^DIR
;
DONE ;
K ^TMP("DILIST",$J)
Q
;
LKUP D FIND^DIC(FILE,"",FIELD,FLAGS,TEXT,"",XREF,"","","","ERROR")
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
Q
;
ASK(II) ;Patient Prompt
NEW DA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="FAO^0:5",DIR("A")="CHOOSE 1-"_II_": "
D ^DIR
I Y="^" S Y="-1" Q Y
I Y'?1N.N S Y="0"
Q Y
;
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=ALIAS
Q ALFND
;
DATE(DATE) ;EP - Convert standard date/time to a FileMan date/time
;Input
; DATE - In a standard format
;Output
; -1 is if it couldn't convert to a FileMan date
; otherwise a standard FileMan date
NEW %DT,X,Y
I DATE[":" D
. I DATE["/",$L(DATE," ")=3 S DATE=$P(DATE," ",1)_"@"_$P(DATE," ",2)_$P(DATE," ",3) Q
. I $L(DATE," ")=3 S DATE=$P(DATE," ",1,2)_"@"_$P(DATE," ",3)
. I $L(DATE," ")>3 S DATE=$P(DATE," ",1,3)_"@"_$P(DATE," ",4,99)
S %DT="TS",X=DATE D ^%DT
I Y=-1 S Y=""
;
Q Y
AMERLKP ;GDIT/HS/ALA-Patient Lookup ; 16 Oct 2013 7:49 AM
+1 ;;3.0;ER VISIT SYSTEM;**5**;MAR 03, 2009;Build 14
+2 ;
SCAN ;EP
+1 ;
+2 NEW DIR,X,Y,TEXT,TYPE,II,BN,QFL,%H,%I
+3 ;
+4 SET DIR("A")="Enter patient NAME, DOB, or LOCAL CHART NUMBER"
+5 SET DIR(0)="F^3:30"
+6 DO ^DIR
+7 ;
+8 ;NOTE: Since "DILIST" is used by the DIC calls it must use $J and not UID.
+9 KILL ^TMP("DILIST",$JOB)
+10 SET TEXT=Y
+11 ;
+12 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AMERLKP D UNWIND^%ZTER"
+13 ;
+14 SET TYPE=""
+15 ;
+16 ;Look for a DOB
+17 IF $$DATE(TEXT)'=""
SET TEXT=$$DATE(TEXT)
SET TYPE="D"
+18 ;
+19 ;If no type of search was passed, the lookup will have to be through all cross-references
+20 IF TYPE=""
Begin DoDot:1
+21 ;Change text to all uppercase
+22 NEW FILE,FIELD,XREF,FLAGS
+23 SET TEXT=$$UP^XLFSTR(TEXT)
+24 SET FILE=9000001
SET FIELD=".01"
SET XREF=""
SET FLAGS="PM"
+25 DO LKUP
End DoDot:1
+26 ;
+27 ;If the type is 'D', do a date of birth lookup
+28 IF TYPE="D"
Begin DoDot:1
+29 SET FILE=2
SET FIELD=.03
SET XREF="ADOB"
SET FLAGS="P"
+30 DO LKUP
End DoDot:1
+31 ;
+32 ; For each patient found in the search, get the list data
+33 SET BN=0
SET QFL=0
SET II=0
+34 FOR
SET BN=$ORDER(^TMP("DILIST",$JOB,BN))
IF 'BN
QUIT
Begin DoDot:1
+35 NEW DFN,NAME,AUPDICW,ALIAS,AMXX,DIC
+36 SET DFN=$PIECE(^TMP("DILIST",$JOB,BN,0),"^",1)
+37 SET NAME=$$GET1^DIQ(9000001,DFN_",",.01,"E")
+38 SET AUPDICW="D IHSDUPE^AUPNLKID D ^AUPNLKID"
+39 SET Y=DFN
SET II=II+1
+40 ;
+41 ;Perform audit log call
+42 DO LOG^AMERBUSA("P","Q","AMERLKP","AMER: Scan Patient Names or Chart Numbers",DFN)
+43 ;
+44 ;Display the patient information
+45 IF TEXT?1A.E
IF $EXTRACT(NAME,1,$LENGTH(TEXT))'=TEXT
SET ALIAS=$$ALIAS(DFN,TEXT)
+46 SET AMXX=^DPT(DFN,0)
SET DIC="^DPT("
+47 WRITE !,II_". "_$SELECT($GET(ALIAS)'="":ALIAS_" "_NAME,1:NAME)
XECUTE AUPDICW
+48 IF II#5=0
SET QFL=$$ASK(II)
End DoDot:1
IF (QFL'=0)
QUIT
+49 ;
+50 ;Display the item
+51 IF QFL>0
Begin DoDot:1
+52 NEW DFN,NAME,AMXX,Y,AUPDICW,DIC,DIR,X,Y
+53 SET DFN=$PIECE(^TMP("DILIST",$JOB,QFL,0),U,1)
SET NAME=$PIECE(^DPT(DFN,0),U,1)
+54 SET AMXX=^DPT(DFN,0)
SET DIC="^DPT("
SET Y=DFN
+55 SET AUPDICW="D IHSDUPE^AUPNLKID D ^AUPNLKID"
+56 WRITE !!,NAME
XECUTE AUPDICW
End DoDot:1
+57 ;
+58 ;Display prompt to continue
+59 WRITE !!
SET DIR(0)="E"
SET DIR("A")="Press 'Return to continue"
+60 DO ^DIR
+61 ;
DONE ;
+1 KILL ^TMP("DILIST",$JOB)
+2 QUIT
+3 ;
LKUP DO FIND^DIC(FILE,"",FIELD,FLAGS,TEXT,"",XREF,"","","","ERROR")
+1 QUIT
+2 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 QUIT
+5 ;
ASK(II) ;Patient Prompt
+1 NEW DA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET DIR(0)="FAO^0:5"
SET DIR("A")="CHOOSE 1-"_II_": "
+3 DO ^DIR
+4 IF Y="^"
SET Y="-1"
QUIT Y
+5 IF Y'?1N.N
SET Y="0"
+6 QUIT Y
+7 ;
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=ALIAS
End DoDot:1
+7 QUIT ALFND
+8 ;
DATE(DATE) ;EP - Convert standard date/time to a FileMan date/time
+1 ;Input
+2 ; DATE - In a standard format
+3 ;Output
+4 ; -1 is if it couldn't convert to a FileMan date
+5 ; otherwise a standard FileMan date
+6 NEW %DT,X,Y
+7 IF DATE[":"
Begin DoDot:1
+8 IF DATE["/"
IF $LENGTH(DATE," ")=3
SET DATE=$PIECE(DATE," ",1)_"@"_$PIECE(DATE," ",2)_$PIECE(DATE," ",3)
QUIT
+9 IF $LENGTH(DATE," ")=3
SET DATE=$PIECE(DATE," ",1,2)_"@"_$PIECE(DATE," ",3)
+10 IF $LENGTH(DATE," ")>3
SET DATE=$PIECE(DATE," ",1,3)_"@"_$PIECE(DATE," ",4,99)
End DoDot:1
+11 SET %DT="TS"
SET X=DATE
DO ^%DT
+12 IF Y=-1
SET Y=""
+13 ;
+14 QUIT Y
