DPTLK7A ;OAK/MKO-MAS PATIENT LOOKUP ENTERPRISE SEARCH (cont) ;13 May 2020 1:13 PM
;;5.3;Registration;**1024**;Aug 13, 1993;Build 1
;**1024,Story 1258907 (mko): Routine created with subroutines ADDTF and CHKSRCID
Q
;
ADDTF(DFN,IDS) ;Add the Treating Facility returned from the Enterprise Search
;In: DFN = DFN of patient
; IDS(seq#,"ID")=Source ID
; IDS(seq#,"IDTYPE")=Source ID Type (e.g., "PI")
; IDS(seq#,"ISSUER")=Assigning Authority (e.g., "USVHA")
; IDS(seq#,"SOURCE")=Facility (e.g., 500M, "200ESR")
; IDS(seq#,"STATUS")=ID Status (e.g., "A", "H")
N AA,IDSTAT,IDTYPE,SEQ,SRCID,STAIEN,STANUM
D FILE^VAFCTFU(DFN,+$$SITE^VASITE,1,1,,,DFN,"A","USVHA","PI")
S SEQ="" F S SEQ=$O(IDS(SEQ)) Q:SEQ="" D
. S STANUM=$G(IDS(SEQ,"SOURCE"))
. S STAIEN=$$IEN^XUAF4($G(IDS(SEQ,"SOURCE"))) Q:STAIEN'>0
. S SRCID=$$CHKSRCID($G(IDS(SEQ,"ID")),STANUM) Q:SRCID=""
. S IDSTAT=$G(IDS(SEQ,"STATUS"))
. S AA=$G(IDS(SEQ,"ISSUER"))
. S IDTYPE=$G(IDS(SEQ,"IDTYPE"))
. D FILE^VAFCTFU(DFN,STAIEN,1,1,,,SRCID,IDSTAT,AA,IDTYPE)
Q
;
CHKSRCID(SRCID,FCLTY) ;Strip leading and trailing 0s from 200ESR source IDs
N CNT
Q:$G(FCLTY)'="200ESR"!($G(SRCID)="") $G(SRCID)
F CNT=1:1 Q:$E(SRCID,CNT)'=0
S SRCID=$E(SRCID,CNT,999)
S:SRCID?10N1"V"6N1."0" SRCID=$E(SRCID,1,17)
Q SRCID
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDPTLK7A 1319 printed Dec 13, 2024@03:01 Page 2
DPTLK7A ;OAK/MKO-MAS PATIENT LOOKUP ENTERPRISE SEARCH (cont) ;13 May 2020 1:13 PM
+1 ;;5.3;Registration;**1024**;Aug 13, 1993;Build 1
+2 ;**1024,Story 1258907 (mko): Routine created with subroutines ADDTF and CHKSRCID
+3 QUIT
+4 ;
ADDTF(DFN,IDS) ;Add the Treating Facility returned from the Enterprise Search
+1 ;In: DFN = DFN of patient
+2 ; IDS(seq#,"ID")=Source ID
+3 ; IDS(seq#,"IDTYPE")=Source ID Type (e.g., "PI")
+4 ; IDS(seq#,"ISSUER")=Assigning Authority (e.g., "USVHA")
+5 ; IDS(seq#,"SOURCE")=Facility (e.g., 500M, "200ESR")
+6 ; IDS(seq#,"STATUS")=ID Status (e.g., "A", "H")
+7 NEW AA,IDSTAT,IDTYPE,SEQ,SRCID,STAIEN,STANUM
+8 DO FILE^VAFCTFU(DFN,+$$SITE^VASITE,1,1,,,DFN,"A","USVHA","PI")
+9 SET SEQ=""
FOR
SET SEQ=$ORDER(IDS(SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+10 SET STANUM=$GET(IDS(SEQ,"SOURCE"))
+11 SET STAIEN=$$IEN^XUAF4($GET(IDS(SEQ,"SOURCE")))
if STAIEN'>0
QUIT
+12 SET SRCID=$$CHKSRCID($GET(IDS(SEQ,"ID")),STANUM)
if SRCID=""
QUIT
+13 SET IDSTAT=$GET(IDS(SEQ,"STATUS"))
+14 SET AA=$GET(IDS(SEQ,"ISSUER"))
+15 SET IDTYPE=$GET(IDS(SEQ,"IDTYPE"))
+16 DO FILE^VAFCTFU(DFN,STAIEN,1,1,,,SRCID,IDSTAT,AA,IDTYPE)
End DoDot:1
+17 QUIT
+18 ;
CHKSRCID(SRCID,FCLTY) ;Strip leading and trailing 0s from 200ESR source IDs
+1 NEW CNT
+2 if $GET(FCLTY)'="200ESR"!($GET(SRCID)="")
QUIT $GET(SRCID)
+3 FOR CNT=1:1
if $EXTRACT(SRCID,CNT)'=0
QUIT
+4 SET SRCID=$EXTRACT(SRCID,CNT,999)
+5 if SRCID?10N1"V"6N1."0"
SET SRCID=$EXTRACT(SRCID,1,17)
+6 QUIT SRCID
