source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DPTDUP.m@ 1607

DPTDUP ;SEA/AMF-ALB/RMO - CHECK FOR DUPLICATES ON NEW PATIENT ENTRY ; 22 JUN 87 1:00 pm
 ;;5.3;Patient File;**50**;Aug 13, 1993
 ; after statistics test, take out all reference to DPTKD,DPTKS
CHK ;
 K DPTD S DPTD=0,DPTN=DPTNM I $P(DPTN,",",1)?.E1P.E S DPTT=$P(DPTN,",",1) D PUNC S DPTN=DPTT_","_$P(DPTN,",",2,99)
 D:$E(DOB,6,7)'="00" DOB D SSN
 G KL
 ;
DOB ;
 S DPTIN=0 F I=0:0 S DPTIN=$O(^DPT("ADOB",DOB,DPTIN)) Q:DPTIN']""  D DOB1 S DPTKD=DPTKD+1
 Q
DOB1 ;
 I '$D(ZTQUEUED) W "."
 S DPTV=^DPT(DPTIN,0),DPTV1=$P(DPTV,U,1)
 I DPTV1?.E1P.E S DPTT=DPTV1 D PUNC S DPTV1=DPTT
 ; proceed no furthur if this is a verified from duplicate already
 I $E($P(DPTN,",",1),1,2)_$E($P(DPTN,",",2),1,2)=($E($P(DPTV1,",",1),1,2)_$E($P(DPTV1,",",2),1,2)) S DPTD(DPTIN)="",DPTD=DPTD+1 Q
 S DPTV1=$P(DPTV,U,9)
 S DPTF=0 F K=1:1:9 Q:(DPTF>2)  I $E(DPTV1,K)'=$E(SSN,K) S DPTF=DPTF+1
 I DPTF<3 S DPTD(DPTIN)="",DPTD=DPTD+1
 Q
SSN ;
 S DPTSSN=$E(SSN,1,5)_"0000" F K=1:1 S DPTSSN=$O(^DPT("SSN",DPTSSN)) Q:DPTSSN']""!($E(DPTSSN,1,5)'=$E(SSN,1,5))  S DPTIN=0 F I=1:1 S DPTIN=$O(^DPT("SSN",DPTSSN,DPTIN)) Q:DPTIN']""  D SSN1 S DPTKS=DPTKS+1
 Q
SSN1 ;
 I '$D(ZTQUEUED) W "."
 Q:$D(DPTD(DPTIN))
 S DPTV1=^DPT(DPTIN,0) I $P(DPTV1,",",1)=$P(DPTN,",",1)!($E(DPTV1,1,2)_$E($P(DPTV1,",",2),1,2)=($E(DPTN,1,2)_$E($P(DPTN,",",2),1,2))) S DPTD(DPTIN)="",DPTD=DPTD+1 Q
 S DPTV=$E(SSN,6,9),DPTV1=$E(DPTSSN,6,9)
 S DPTF=0 F K=1:1:4 Q:(DPTF>2)  I $E(DPTV,K)'=$E(DPTV1,K) S DPTF=DPTF+1
 I DPTF<3 S DPTD(DPTIN)="",DPTD=DPTD+1
 Q
PUNC ;
 F I=1:1:$L(DPTT) I $E(DPTT,I)?1P,$E(DPTT,I)'="," S DPTT=$E(DPTT,1,I-1)_$E(DPTT,I+1,99)
 Q
KL ;
 K DPTIN,DPTV,DPTV1,DPTF,DPTSSN,DPTT,DPTN
 Q