EDPFPTL ;SLC/KCM - Select Patient at Facility ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
MATCH(MATCH) ; return XML of matching patients
S MATCH=$$UP^XLFSTR(MATCH)
Q:MATCH=""
;
S:+MATCH MATCH=$TR(MATCH,"-","")
;
N LST S LST=0
N LIMIT S LIMIT=100
I MATCH?4N D BS(MATCH)
I MATCH?1U4N D BS5(MATCH)
I MATCH?9N.1U D SSN(MATCH)
D LNAM(MATCH)
I LST=0 D NONE("No matches found.")
I LST>0 D LIST(.LST)
I LIMIT<1 D
. D NONE("Limit of 100 matches reached.")
. D XML^EDPX("<matchesTruncated>true</matchesTruncated>")
Q
;
NONE(MSG) ; create a "no match" entry
N X
S X("name")=MSG
S X("ssn")="",X("dob")="",X("dfn")=0
D XML^EDPX($$XMLA^EDPX("ptlk",.X))
Q
LIST(LST) ; list names that match
N I,X,DFN,NAME
S NAME="" F S NAME=$O(LST(NAME)) Q:NAME="" D
. S DFN=0 F S DFN=$O(LST(NAME,DFN)) Q:'DFN D
.. S X("name")=NAME
.. S X("ssn")=$$SSN^DPTLK1(DFN) ; DG249
.. S X("dob")=$$DOB^DPTLK1(DFN) ; DG249
.. S X("dfn")=DFN
.. D XML^EDPX($$XMLA^EDPX("ptlk",.X))
Q
BS(X) ; find matches on 9999 (BS)
; expects LST,LIMIT to be defined
N DFN S DFN=0
F S DFN=$O(^DPT("BS",X,DFN)) Q:'DFN D
. S LIMIT=LIMIT-1 I LIMIT<1 Q
. S LST=LST+1,LST($P(^DPT(DFN,0),U),DFN)=""
Q
BS5(X) ; find matches on X9999 (BS5)
; expects LST,LIMIT to be defined
N DFN S DFN=0
F S DFN=$O(^DPT("BS5",X,DFN)) Q:'DFN D
. S LIMIT=LIMIT-1 I LIMIT<1 Q
. S LST=LST+1,LST($P(^DPT(DFN,0),U),DFN)=""
Q
SSN(X) ; find matches on 999999999 (SSN)
; expects LST,LIMIT to be defined
N DFN S DFN=0
F S DFN=$O(^DPT("SSN",X,DFN)) Q:'DFN D
. S LIMIT=LIMIT-1 I LIMIT<1 Q
. S LST=LST+1,LST($P(^DPT(DFN,0),U),DFN)=""
Q
LNAM(X) ; find matches on name (B)
; expects LST,LIMIT to be defined
N DFN,NAME
S NAME=$O(^DPT("B",X),-1)
F S NAME=$O(^DPT("B",NAME)) Q:$E(NAME,1,$L(X))'=X Q:NAME="" Q:LIMIT<1 D
. S DFN=0 F S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN D
.. S LIMIT=LIMIT-1 I LIMIT<1 Q
.. S LST=LST+1,LST(NAME,DFN)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPFPTL 2002 printed Apr 09, 2024@20:57:24 Page 2
EDPFPTL ;SLC/KCM - Select Patient at Facility ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
MATCH(MATCH) ; return XML of matching patients
+1 SET MATCH=$$UP^XLFSTR(MATCH)
+2 if MATCH=""
QUIT
+3 ;
+4 if +MATCH
SET MATCH=$TRANSLATE(MATCH,"-","")
+5 ;
+6 NEW LST
SET LST=0
+7 NEW LIMIT
SET LIMIT=100
+8 IF MATCH?4N
DO BS(MATCH)
+9 IF MATCH?1U4N
DO BS5(MATCH)
+10 IF MATCH?9N.1U
DO SSN(MATCH)
+11 DO LNAM(MATCH)
+12 IF LST=0
DO NONE("No matches found.")
+13 IF LST>0
DO LIST(.LST)
+14 IF LIMIT<1
Begin DoDot:1
+15 DO NONE("Limit of 100 matches reached.")
+16 DO XML^EDPX("<matchesTruncated>true</matchesTruncated>")
End DoDot:1
+17 QUIT
+18 ;
NONE(MSG) ; create a "no match" entry
+1 NEW X
+2 SET X("name")=MSG
+3 SET X("ssn")=""
SET X("dob")=""
SET X("dfn")=0
+4 DO XML^EDPX($$XMLA^EDPX("ptlk",.X))
+5 QUIT
LIST(LST) ; list names that match
+1 NEW I,X,DFN,NAME
+2 SET NAME=""
FOR
SET NAME=$ORDER(LST(NAME))
if NAME=""
QUIT
Begin DoDot:1
+3 SET DFN=0
FOR
SET DFN=$ORDER(LST(NAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+4 SET X("name")=NAME
+5 ; DG249
SET X("ssn")=$$SSN^DPTLK1(DFN)
+6 ; DG249
SET X("dob")=$$DOB^DPTLK1(DFN)
+7 SET X("dfn")=DFN
+8 DO XML^EDPX($$XMLA^EDPX("ptlk",.X))
End DoDot:2
End DoDot:1
+9 QUIT
BS(X) ; find matches on 9999 (BS)
+1 ; expects LST,LIMIT to be defined
+2 NEW DFN
SET DFN=0
+3 FOR
SET DFN=$ORDER(^DPT("BS",X,DFN))
if 'DFN
QUIT
Begin DoDot:1
+4 SET LIMIT=LIMIT-1
IF LIMIT<1
QUIT
+5 SET LST=LST+1
SET LST($PIECE(^DPT(DFN,0),U),DFN)=""
End DoDot:1
+6 QUIT
BS5(X) ; find matches on X9999 (BS5)
+1 ; expects LST,LIMIT to be defined
+2 NEW DFN
SET DFN=0
+3 FOR
SET DFN=$ORDER(^DPT("BS5",X,DFN))
if 'DFN
QUIT
Begin DoDot:1
+4 SET LIMIT=LIMIT-1
IF LIMIT<1
QUIT
+5 SET LST=LST+1
SET LST($PIECE(^DPT(DFN,0),U),DFN)=""
End DoDot:1
+6 QUIT
SSN(X) ; find matches on 999999999 (SSN)
+1 ; expects LST,LIMIT to be defined
+2 NEW DFN
SET DFN=0
+3 FOR
SET DFN=$ORDER(^DPT("SSN",X,DFN))
if 'DFN
QUIT
Begin DoDot:1
+4 SET LIMIT=LIMIT-1
IF LIMIT<1
QUIT
+5 SET LST=LST+1
SET LST($PIECE(^DPT(DFN,0),U),DFN)=""
End DoDot:1
+6 QUIT
LNAM(X) ; find matches on name (B)
+1 ; expects LST,LIMIT to be defined
+2 NEW DFN,NAME
+3 SET NAME=$ORDER(^DPT("B",X),-1)
+4 FOR
SET NAME=$ORDER(^DPT("B",NAME))
if $EXTRACT(NAME,1,$LENGTH(X))'=X
QUIT
if NAME=""
QUIT
if LIMIT<1
QUIT
Begin DoDot:1
+5 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("B",NAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+6 SET LIMIT=LIMIT-1
IF LIMIT<1
QUIT
+7 SET LST=LST+1
SET LST(NAME,DFN)=""
End DoDot:2
End DoDot:1
+8 QUIT
