DPTLK7A.m

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 ---DPTLK7A   1319     printed  Apr 09, 2024@21:43:50                                                                                                                                                                                                     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