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

Last change on this file since 1394 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1DPTDUP ;SEA/AMF-ALB/RMO - CHECK FOR DUPLICATES ON NEW PATIENT ENTRY ; 22 JUN 87 1:00 pm
2 ;;5.3;Patient File;**50**;Aug 13, 1993
3 ; after statistics test, take out all reference to DPTKD,DPTKS
4CHK ;
5 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)
6 D:$E(DOB,6,7)'="00" DOB D SSN
7 G KL
8 ;
9DOB ;
10 S DPTIN=0 F I=0:0 S DPTIN=$O(^DPT("ADOB",DOB,DPTIN)) Q:DPTIN']"" D DOB1 S DPTKD=DPTKD+1
11 Q
12DOB1 ;
13 I '$D(ZTQUEUED) W "."
14 S DPTV=^DPT(DPTIN,0),DPTV1=$P(DPTV,U,1)
15 I DPTV1?.E1P.E S DPTT=DPTV1 D PUNC S DPTV1=DPTT
16 ; proceed no furthur if this is a verified from duplicate already
17 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
18 S DPTV1=$P(DPTV,U,9)
19 S DPTF=0 F K=1:1:9 Q:(DPTF>2) I $E(DPTV1,K)'=$E(SSN,K) S DPTF=DPTF+1
20 I DPTF<3 S DPTD(DPTIN)="",DPTD=DPTD+1
21 Q
22SSN ;
23 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
24 Q
25SSN1 ;
26 I '$D(ZTQUEUED) W "."
27 Q:$D(DPTD(DPTIN))
28 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
29 S DPTV=$E(SSN,6,9),DPTV1=$E(DPTSSN,6,9)
30 S DPTF=0 F K=1:1:4 Q:(DPTF>2) I $E(DPTV,K)'=$E(DPTV1,K) S DPTF=DPTF+1
31 I DPTF<3 S DPTD(DPTIN)="",DPTD=DPTD+1
32 Q
33PUNC ;
34 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)
35 Q
36KL ;
37 K DPTIN,DPTV,DPTV1,DPTF,DPTSSN,DPTT,DPTN
38 Q
Note: See TracBrowser for help on using the repository browser.