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
 
I,DFN,DFNS,HMPCNT,ICN,PID,CRITFND
 
RET(1)="" ; Default to empty string return
 
I $G(SEARCH)="" RET(1)="-1^No patient specified." Q
 I $G
(CRIT)="" 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
 
CRIT="LAST5" SRLAST5(SEARCHCRITFND=1 ; Search by last5
 
CRIT="NAME" SRNAME(SEARCHCRITFND=1 ; Search by (partial) name
 
CRIT="ICN" DFNS(1)=$$GETDFN^MPIF001(SEARCH),ICN=SEARCH,CRITFND=1 ; ICN
 
CRIT="PID" 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 RET(1)="-1^Can only resolve pid for local site." Q
 
;If we couldn't match a search criteria, return an error
 
'CRITFND RET(1)="-1^Invalid search criteria requested" Q
 I 
+$G(DFNS(1))=-1 RET(1)="" Q
 S 
HMPCNT="" F  S HMPCNT=$O(DFNS(HMPCNT)) Q:HMPCNT=""  DFN=DFNS(HMPCNTD
 
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")
 
DEM^VADPT
 . 
;DE3160 If no icn for patient then set ICN="" so that an extra field in return data does not get returned.
 
ICN=$$GETICN^MPIF001(DFNICN<0 ICN=""
 
SENS=$S($$EN1^ORQPT2(DFN)=1:"true",1:"false")
 . 
DOB=$TR($$FMTE^XLFDT(+$P($P($G(VADM(3)),U),"."),"7DZ"),"/","")
 . 
FULLNAME=$G(VADM(1))
 . 
FAMNAME=$P(FULLNAME,",",1),GVNNAME=$P(FULLNAME,",",2,99)
 . 
DISPNAME=$$FRSTCPS(FULLNAME),SUMMARY=DISPNAME
 
GNDRCODE="urn:va:pat-gender:"_$P($G(VADM(5)),U),GNDRNAME=$P($G(VADM(5)),U,2)
 . 
LAST4=$P($P($G(VADM(2)),U,2),"-",3),LAST5=$E(FAMNAME,1)_LAST4,SSN="*****"_LAST4
 
PID=$$SYS^HMPUTILS_";"_DFN
 
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
 
RET(HMPCNT)=RET(HMPCNT)_U_PID_U_ICN_U_SUMMARY
 
Q
SRLAST5(SEARCH) ; Search for patients by last5
 
FIND(SEARCH,"BS5")
 
Q
SRNAME(SEARCH) ; Search for patients by name
 
FIND(SEARCH,"")
 
Q
FIND(SEARCH,XREF) ; Find patients that match search term in x-ref
 
HMPFIND,HMPERR
 
FIND^DIC(2,,"@","P",SEARCH,,XREF,,,"HMPFIND","HMPERR")
 
I=1:1:+$G(HMPFIND("DILIST",0)) DFNS(I)=HMPFIND("DILIST",I,0)
 
Q
FRSTCPS(IN) ; Formats patient's name to begin each word with a capital and the rest lowercase
 
FRSTCHAR,OUT
 
FRSTCHAR=1,OUT=""
 
I=1:1:$L(IND
 
CHAR CHAR=$E($E(IN,I))
 . 
I $$ISALPHA(CHARD  Q
 
. . FRSTCHAR OUT=OUT_CHAR,FRSTCHAR=0 Q
 
. . OUT=OUT_$$LOW^XLFSTR(CHAR)
 . 
;otherwise, non-alphabetic character
 
OUT=OUT_CHAR,FRSTCHAR=1
 
OUT
ISALPHA(CHAR) ;
 
CHAR?1A
 
;