BSDX28	; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/10 3:55pm
	;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
	;
	; HMW 3050721 Added test for inactivated record
    ; SMH 3100714 add PID search, return PID instead of SSN
    ; Change Error trap to new style.
	;
PTLOOKRS(BSDXY,BSDXP,BSDXC)	 ;EP Patient Lookup
	;
	;Find up to BSDXC patients matching BSDXP*
	;Supports DOB Lookup, Primary Long ID lookup
	;
	N $ET S $ET="G ERROR^BSDX28"
    ; rm ctrl chars
	S BSDXP=$TR(BSDXP,$C(13),"")
	S BSDXP=$TR(BSDXP,$C(10),"")
	S BSDXP=$TR(BSDXP,$C(9),"")
    ; num of pts to find
	S:BSDXC="" BSDXC=10
	N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
	N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
	N BSDXTARG,BSDXMSG,BSDXRSLT
	S BSDXDLIM="^"
	S BSDXRET="T00030NAME^T00030HRN^T00030PID^D00030DOB^T00030IEN"_$C(30)
	I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
	I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q

PID ;PID Lookup
    ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
    ; won't work anyways.
    I $D(^DPT("UJOPID",BSDXP)) DO  SET BSDXY=BSDXRET_$C(31) QUIT
    . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
    . Q:'$D(^DPT(BSDXIEN,0))
    . S BSDXDPT=$G(^DPT(BSDXIEN,0))
    . S BSDXZ=$P(BSDXDPT,U) ;NAME
    . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
    . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
    . ; Inactivated Chart get an *
    . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
    . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
    . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
    . S BSDXRET=BSDXRET_BSDXZ_$C(30)
	;
DOB	;DOB Lookup
	I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D  S BSDXY=BSDXRET_$C(31) Q
	. S X=BSDXP S %DT="P" D ^%DT S BSDXP=Y Q:'+Y
	. Q:'$D(^DPT("ADOB",BSDXP))
	. S BSDXIEN=0 F  S BSDXIEN=$O(^DPT("ADOB",BSDXP,BSDXIEN)) Q:'+BSDXIEN  D
	. . Q:'$D(^DPT(BSDXIEN,0))
	. . S BSDXDPT=$G(^DPT(BSDXIEN,0))
	. . S BSDXZ=$P(BSDXDPT,U) ;NAME
	. . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
	. . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
	. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
	. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
	. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
	. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
	. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
	. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
	. . Q
	. Q
	;
CHART
    ;Chart# Lookup
	I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
	. S BSDXIEN=0 F  S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN  I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D  Q
	. . Q:'$D(^DPT(BSDXIEN,0))
	. . S BSDXDPT=$G(^DPT(BSDXIEN,0))
	. . S BSDXZ=$P(BSDXDPT,U) ;NAME
	. . S BSDXHRN=BSDXP ;CHART
	. . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
	. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
	. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
	. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
	. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
	. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
	. . Q
	. Q
    ;
SSN	;SSN Lookup
	I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
	. S BSDXIEN=0 F  S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN  D  Q
	. . Q:'$D(^DPT(BSDXIEN,0))
	. . S BSDXDPT=$G(^DPT(BSDXIEN,0))
	. . S BSDXZ=$P(BSDXDPT,U) ;NAME
	. . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
	. . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
	. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
	. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
	. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
	. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
	. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
	. . S BSDXRET=BSDXRET_BSDXZ_$C(30)
	. . Q
	. Q
	;
	S BSDXFILE=9000001
	S BSDXIENS=""
	S BSDXFIELDS=".01"
	S BSDXFLAGS="M"
	S BSDXVALUE=BSDXP
	S BSDXNUMBER=BSDXC
	S BSDXINDEXES=""
	S BSDXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
	S BSDXIDEN=""
	S BSDXTARG="BSDXRSLT"
	S BSDXMSG=""
	D FIND^DIC(BSDXFILE,BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN,BSDXIDEN,BSDXTARG,BSDXMSG)
	I '+$G(BSDXRSLT("DILIST",0)) S BSDXY=BSDXRET_$C(31) Q
	N BSDXCNT S BSDXCNT=2
	F BSDXX=1:1:$P(BSDXRSLT("DILIST",0),U) D
	. S BSDXIEN=BSDXRSLT("DILIST",2,BSDXX)
	. S BSDXZ=BSDXRSLT("DILIST","ID",BSDXX,.01) ;NAME
	. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
	. I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
	. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
	. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
	. S BSDXDPT=$G(^DPT(BSDXIEN,0))
    . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
	. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
	. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
	. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
	. S $P(BSDXRET,$C(30),BSDXCNT)=BSDXZ
	. S BSDXCNT=BSDXCNT+1
	. Q
	S BSDXY=BSDXRET_$C(30)_$C(31)
	Q
	;
ERROR	;
	D ERR("RPMS Error")
	Q
	;
ERR(ERRNO)	;Error processing
	S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)_"^^^^"_$C(30)_$C(31)
	Q