DG CHK BS5 XREF ARRAY

 with same last name
 returns 1 or 0 in 1st string (or -1 if bad DFN or no zero node)
 if 1 returns array nodes where
 text is preceeded by 0 (0^) 
 and patient data is preceeded by 1 (1^DFN^patient name^DOB^SSN)
 return type:  global array
 parameter:  ien of Patient file

 K GUIDATA
 I '$G(DFN) S GUIDATA(1)=-1 Q
 I '$D(^DPT(DFN,0)) S GUIDATA(1)=-1 Q
 I '$$BS5^DPTLK5(DFN) S GUIDATA(1)=0 Q
 K ^TMP("DPTLK6",$J)
 S ^TMP("DPTLK6",$J,1)=1
 N DPT0,DPTNME,DPTSSN,DPTBS5,DPTLAST,DPTIEN,DPTCNT,DPTDOB,DPTSSN1
 S DPT0=^DPT(DFN,0)
 S DPTNME=$E(DPT0,1),DPTSSN=$E($P(DPT0,U,9),6,9)
 S DPTBS5=DPTNME_DPTSSN
 S DPTLAST=$P($P(DPT0,U),",")
 S ^TMP("DPTLK6",$J,2)="0^There is more than one patient whose last name is "_DPTLAST
 S ^TMP("DPTLK6",$J,3)="0^and whose social security number ends with "_DPTSSN
 S DPTCNT=3
 S DPTIEN=0
 F  S DPTIEN=$O(^DPT("BS5",DPTBS5,DPTIEN)) Q:'DPTIEN  D
 .S DPT0=$G(^DPT(DPTIEN,0)),DPTNME=$P($P(DPT0,U),",")
 .Q:DPTNME'=DPTLAST
 .S DPTNME=$P(DPT0,U)
 .I $T(DOB^DPTLK1)'="" S DPTDOB=$$DOB^DPTLK1(DPTIEN,2),DPTSSN1=$$SSN^DPTLK1(DPTIEN)
 .E  S DPTDOB=$P(DPT0,U,3),DPTSSN1=$P(DPT0,U,9)
 .S DPTCNT=DPTCNT+1
 .S ^TMP("DPTLK6",$J,DPTCNT)="1"_U_DPTIEN_U_DPTNME_U_DPTDOB_U_DPTSSN1
 S DPTCNT=DPTCNT+1
 S ^TMP("DPTLK6",$J,DPTCNT)="0^Are you sure you wish to continue?"
 M GUIDATA=^TMP("DPTLK6",$J)
 K ^TMP("DPTLK6",$J)