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

EDPFPTL.m

Go to the documentation of this file.
  1. EDPFPTL ;SLC/KCM - Select Patient at Facility ;2/28/12 08:33am
  1. ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
  1. ;
  1. MATCH(MATCH) ; return XML of matching patients
  1. S MATCH=$$UP^XLFSTR(MATCH)
  1. Q:MATCH=""
  1. ;
  1. S:+MATCH MATCH=$TR(MATCH,"-","")
  1. ;
  1. N LST S LST=0
  1. N LIMIT S LIMIT=100
  1. I MATCH?4N D BS(MATCH)
  1. I MATCH?1U4N D BS5(MATCH)
  1. I MATCH?9N.1U D SSN(MATCH)
  1. D LNAM(MATCH)
  1. I LST=0 D NONE("No matches found.")
  1. I LST>0 D LIST(.LST)
  1. I LIMIT<1 D
  1. . D NONE("Limit of 100 matches reached.")
  1. . D XML^EDPX("<matchesTruncated>true</matchesTruncated>")
  1. Q
  1. ;
  1. NONE(MSG) ; create a "no match" entry
  1. N X
  1. S X("name")=MSG
  1. S X("ssn")="",X("dob")="",X("dfn")=0
  1. D XML^EDPX($$XMLA^EDPX("ptlk",.X))
  1. Q
  1. LIST(LST) ; list names that match
  1. N I,X,DFN,NAME
  1. S NAME="" F S NAME=$O(LST(NAME)) Q:NAME="" D
  1. . S DFN=0 F S DFN=$O(LST(NAME,DFN)) Q:'DFN D
  1. .. S X("name")=NAME
  1. .. S X("ssn")=$$SSN^DPTLK1(DFN) ; DG249
  1. .. S X("dob")=$$DOB^DPTLK1(DFN) ; DG249
  1. .. S X("dfn")=DFN
  1. .. D XML^EDPX($$XMLA^EDPX("ptlk",.X))
  1. Q
  1. BS(X) ; find matches on 9999 (BS)
  1. ; expects LST,LIMIT to be defined
  1. N DFN S DFN=0
  1. F S DFN=$O(^DPT("BS",X,DFN)) Q:'DFN D
  1. . S LIMIT=LIMIT-1 I LIMIT<1 Q
  1. . S LST=LST+1,LST($P(^DPT(DFN,0),U),DFN)=""
  1. Q
  1. BS5(X) ; find matches on X9999 (BS5)
  1. ; expects LST,LIMIT to be defined
  1. N DFN S DFN=0
  1. F S DFN=$O(^DPT("BS5",X,DFN)) Q:'DFN D
  1. . S LIMIT=LIMIT-1 I LIMIT<1 Q
  1. . S LST=LST+1,LST($P(^DPT(DFN,0),U),DFN)=""
  1. Q
  1. SSN(X) ; find matches on 999999999 (SSN)
  1. ; expects LST,LIMIT to be defined
  1. N DFN S DFN=0
  1. F S DFN=$O(^DPT("SSN",X,DFN)) Q:'DFN D
  1. . S LIMIT=LIMIT-1 I LIMIT<1 Q
  1. . S LST=LST+1,LST($P(^DPT(DFN,0),U),DFN)=""
  1. Q
  1. LNAM(X) ; find matches on name (B)
  1. ; expects LST,LIMIT to be defined
  1. N DFN,NAME
  1. S NAME=$O(^DPT("B",X),-1)
  1. F S NAME=$O(^DPT("B",NAME)) Q:$E(NAME,1,$L(X))'=X Q:NAME="" Q:LIMIT<1 D
  1. . S DFN=0 F S DFN=$O(^DPT("B",NAME,DFN)) Q:'DFN D
  1. .. S LIMIT=LIMIT-1 I LIMIT<1 Q
  1. .. S LST=LST+1,LST(NAME,DFN)=""
  1. Q