39 lines
1.6 KiB
Mathematica
39 lines
1.6 KiB
Mathematica
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
|