HMPPTRPC ;ASMR/MBS,CK - Patient Select RPC;May 15, 2016 14:15
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2**;May 15, 2016;Build 28
;Per VA Directive 6402, this routine should not be modified.
; ROUTINE IA#
; XLFSTR 10104
; XLFSTR 10104
; VADPT 10061
; MPIF001 2701
; ORQPT2
; XLFDT
; DIC
;
Q
SELECT(RET,CRIT,SEARCH) ; Returns patient information based on search
N I,DFN,DFNS,HMPCNT,ICN,PID,CRITFND
S RET(1)="" ; Default to empty string return
I $G(SEARCH)="" S RET(1)="-1^No patient specified." Q
I $G(CRIT)="" S RET(1)="-1^No search critera specified." Q
S CRIT=$$UP^XLFSTR(CRIT),CRITFND=0 ; CRITFND will be 1 if we matched the CRIT to a criteria
I CRIT="LAST5" D SRLAST5(SEARCH) S CRITFND=1 ; Search by last5
I CRIT="NAME" D SRNAME(SEARCH) S CRITFND=1 ; Search by (partial) name
I CRIT="ICN" S DFNS(1)=$$GETDFN^MPIF001(SEARCH),ICN=SEARCH,CRITFND=1 ; ICN
I CRIT="PID" S DFNS(1)=$P(SEARCH,";",2),PID=SEARCH,CRITFND=1 ; PID - assume 2nd piece is DFN for *this* server
I $G(PID)]"",$P(PID,";")'=$$SYS^HMPUTILS S RET(1)="-1^Can only resolve pid for local site." Q
;If we couldn't match a search criteria, return an error
I 'CRITFND S RET(1)="-1^Invalid search criteria requested" Q
I +$G(DFNS(1))=-1 S RET(1)="" Q
S HMPCNT="" F S HMPCNT=$O(DFNS(HMPCNT)) Q:HMPCNT="" S DFN=DFNS(HMPCNT) D
. N ICN,SENS,SSN,DOB,FULLNAME,FAMNAME,DISPNAME,SUMMARY,GNDRCODE,LAST4,LAST5,PID,GNDRNAME,VADM,GVNNAME
. I $$GET1^DIQ(2,DFN,".01")="" Q ; Skip entries that don't match a valid DFN (mostly useful if CRIT was "PID")
. D DEM^VADPT
. ;DE3160 If no icn for patient then set ICN="" so that an extra field in return data does not get returned.
. S ICN=$$GETICN^MPIF001(DFN) I ICN<0 S ICN=""
. S SENS=$S($$EN1^ORQPT2(DFN)=1:"true",1:"false")
. S DOB=$TR($$FMTE^XLFDT(+$P($P($G(VADM(3)),U),"."),"7DZ"),"/","")
. S FULLNAME=$G(VADM(1))
. S FAMNAME=$P(FULLNAME,",",1),GVNNAME=$P(FULLNAME,",",2,99)
. S DISPNAME=$$FRSTCPS(FULLNAME),SUMMARY=DISPNAME
. S GNDRCODE="urn:va:pat-gender:"_$P($G(VADM(5)),U),GNDRNAME=$P($G(VADM(5)),U,2)
. S LAST4=$P($P($G(VADM(2)),U,2),"-",3),LAST5=$E(FAMNAME,1)_LAST4,SSN="*****"_LAST4
. S PID=$$SYS^HMPUTILS_";"_DFN
. S RET(HMPCNT)=FULLNAME_U_FAMNAME_U_GVNNAME_U_DISPNAME_U_GNDRCODE_U_GNDRNAME_U_SSN_U_LAST4_U_LAST5_U_DOB_U_SENS_U_DFN
. S RET(HMPCNT)=RET(HMPCNT)_U_PID_U_ICN_U_SUMMARY
Q
SRLAST5(SEARCH) ; Search for patients by last5
D FIND(SEARCH,"BS5")
Q
SRNAME(SEARCH) ; Search for patients by name
D FIND(SEARCH,"")
Q
FIND(SEARCH,XREF) ; Find patients that match search term in x-ref
N HMPFIND,HMPERR
D FIND^DIC(2,,"@","P",SEARCH,,XREF,,,"HMPFIND","HMPERR")
F I=1:1:+$G(HMPFIND("DILIST",0)) S DFNS(I)=HMPFIND("DILIST",I,0)
Q
FRSTCPS(IN) ; Formats patient's name to begin each word with a capital and the rest lowercase
N FRSTCHAR,OUT
S FRSTCHAR=1,OUT=""
F I=1:1:$L(IN) D
. N CHAR S CHAR=$E($E(IN,I))
. I $$ISALPHA(CHAR) D Q
. . I FRSTCHAR S OUT=OUT_CHAR,FRSTCHAR=0 Q
. . S OUT=OUT_$$LOW^XLFSTR(CHAR)
. ;otherwise, non-alphabetic character
. S OUT=OUT_CHAR,FRSTCHAR=1
Q OUT
ISALPHA(CHAR) ;
Q CHAR?1A
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPPTRPC 3191 printed Sep 23, 2025@19:30:34 Page 2
HMPPTRPC ;ASMR/MBS,CK - Patient Select RPC;May 15, 2016 14:15
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2**;May 15, 2016;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; ROUTINE IA#
+4 ; XLFSTR 10104
+5 ; XLFSTR 10104
+6 ; VADPT 10061
+7 ; MPIF001 2701
+8 ; ORQPT2
+9 ; XLFDT
+10 ; DIC
+11 ;
+12 QUIT
SELECT(RET,CRIT,SEARCH) ; Returns patient information based on search
+1 NEW I,DFN,DFNS,HMPCNT,ICN,PID,CRITFND
+2 ; Default to empty string return
SET RET(1)=""
+3 IF $GET(SEARCH)=""
SET RET(1)="-1^No patient specified."
QUIT
+4 IF $GET(CRIT)=""
SET RET(1)="-1^No search critera specified."
QUIT
+5 ; CRITFND will be 1 if we matched the CRIT to a criteria
SET CRIT=$$UP^XLFSTR(CRIT)
SET CRITFND=0
+6 ; Search by last5
IF CRIT="LAST5"
DO SRLAST5(SEARCH)
SET CRITFND=1
+7 ; Search by (partial) name
IF CRIT="NAME"
DO SRNAME(SEARCH)
SET CRITFND=1
+8 ; ICN
IF CRIT="ICN"
SET DFNS(1)=$$GETDFN^MPIF001(SEARCH)
SET ICN=SEARCH
SET CRITFND=1
+9 ; PID - assume 2nd piece is DFN for *this* server
IF CRIT="PID"
SET DFNS(1)=$PIECE(SEARCH,";",2)
SET PID=SEARCH
SET CRITFND=1
+10 IF $GET(PID)]""
IF $PIECE(PID,";")'=$$SYS^HMPUTILS
SET RET(1)="-1^Can only resolve pid for local site."
QUIT
+11 ;If we couldn't match a search criteria, return an error
+12 IF 'CRITFND
SET RET(1)="-1^Invalid search criteria requested"
QUIT
+13 IF +$GET(DFNS(1))=-1
SET RET(1)=""
QUIT
+14 SET HMPCNT=""
FOR
SET HMPCNT=$ORDER(DFNS(HMPCNT))
if HMPCNT=""
QUIT
SET DFN=DFNS(HMPCNT)
Begin DoDot:1
+15 NEW ICN,SENS,SSN,DOB,FULLNAME,FAMNAME,DISPNAME,SUMMARY,GNDRCODE,LAST4,LAST5,PID,GNDRNAME,VADM,GVNNAME
+16 ; Skip entries that don't match a valid DFN (mostly useful if CRIT was "PID")
IF $$GET1^DIQ(2,DFN,".01")=""
QUIT
+17 DO DEM^VADPT
+18 ;DE3160 If no icn for patient then set ICN="" so that an extra field in return data does not get returned.
+19 SET ICN=$$GETICN^MPIF001(DFN)
IF ICN<0
SET ICN=""
+20 SET SENS=$SELECT($$EN1^ORQPT2(DFN)=1:"true",1:"false")
+21 SET DOB=$TRANSLATE($$FMTE^XLFDT(+$PIECE($PIECE($GET(VADM(3)),U),"."),"7DZ"),"/","")
+22 SET FULLNAME=$GET(VADM(1))
+23 SET FAMNAME=$PIECE(FULLNAME,",",1)
SET GVNNAME=$PIECE(FULLNAME,",",2,99)
+24 SET DISPNAME=$$FRSTCPS(FULLNAME)
SET SUMMARY=DISPNAME
+25 SET GNDRCODE="urn:va:pat-gender:"_$PIECE($GET(VADM(5)),U)
SET GNDRNAME=$PIECE($GET(VADM(5)),U,2)
+26 SET LAST4=$PIECE($PIECE($GET(VADM(2)),U,2),"-",3)
SET LAST5=$EXTRACT(FAMNAME,1)_LAST4
SET SSN="*****"_LAST4
+27 SET PID=$$SYS^HMPUTILS_";"_DFN
+28 SET RET(HMPCNT)=FULLNAME_U_FAMNAME_U_GVNNAME_U_DISPNAME_U_GNDRCODE_U_GNDRNAME_U_SSN_U_LAST4_U_LAST5_U_DOB_U_SENS_U_DFN
+29 SET RET(HMPCNT)=RET(HMPCNT)_U_PID_U_ICN_U_SUMMARY
End DoDot:1
+30 QUIT
SRLAST5(SEARCH) ; Search for patients by last5
+1 DO FIND(SEARCH,"BS5")
+2 QUIT
SRNAME(SEARCH) ; Search for patients by name
+1 DO FIND(SEARCH,"")
+2 QUIT
FIND(SEARCH,XREF) ; Find patients that match search term in x-ref
+1 NEW HMPFIND,HMPERR
+2 DO FIND^DIC(2,,"@","P",SEARCH,,XREF,,,"HMPFIND","HMPERR")
+3 FOR I=1:1:+$GET(HMPFIND("DILIST",0))
SET DFNS(I)=HMPFIND("DILIST",I,0)
+4 QUIT
FRSTCPS(IN) ; Formats patient's name to begin each word with a capital and the rest lowercase
+1 NEW FRSTCHAR,OUT
+2 SET FRSTCHAR=1
SET OUT=""
+3 FOR I=1:1:$LENGTH(IN)
Begin DoDot:1
+4 NEW CHAR
SET CHAR=$EXTRACT($EXTRACT(IN,I))
+5 IF $$ISALPHA(CHAR)
Begin DoDot:2
+6 IF FRSTCHAR
SET OUT=OUT_CHAR
SET FRSTCHAR=0
QUIT
+7 SET OUT=OUT_$$LOW^XLFSTR(CHAR)
End DoDot:2
QUIT
+8 ;otherwise, non-alphabetic character
+9 SET OUT=OUT_CHAR
SET FRSTCHAR=1
End DoDot:1
+10 QUIT OUT
ISALPHA(CHAR) ;
+1 QUIT CHAR?1A
+2 ;
