- 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 Feb 18, 2025@23:18:18 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