XDRPTDOB ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES DATE OF BIRTHS; ;1/27/97 15:11
;;7.3;TOOLKIT;**23**;Apr 25, 1995
;;
START ;
D INIT
EN ; EP - Entry point for comparing dates
D COMPARE
END D EOJ
Q
;
INIT ;
K XDRDOB,XDRDOB2
S XDRDOB=XDRCD(XDRFL,XDRCD,.03,"I"),XDRDOB2=XDRCD2(XDRFL,XDRCD2,.03,"I")
S XDRDOB("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
S XDRDOB("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
Q
;
COMPARE ;
S XDRD("TEST SCORE")=$$DATECOMP(XDRDOB,XDRDOB2,XDRDOB("MATCH"),XDRDOB("NO MATCH"),.8,.6)
Q
;
DATECOMP(DATE1,DATE2,MATCH,NOMATCH,VAL1,VAL2) ;
N Y
S Y=$$NUMCOMP^XDRPTCLN(DATE1,DATE2,MATCH,NOMATCH,VAL1)
I Y=NOMATCH D
. I $E(DATE1,4,5)="00"!($E(DATE2,4,5)="00") S DATE1=$E(DATE1,1,3)_"0000",DATE2=$E(DATE2,1,3)_"0000" S MATCH=VAL2*MATCH
. I $E(DATE1,4,5)'="00",$E(DATE1,6,7)="00"!($E(DATE2,6,7)="00") S DATE1=$E(DATE1,1,5)_"00",DATE2=$E(DATE2,1,5)_"00" S MATCH=VAL1*MATCH
. S Y=$$NUMCOMP^XDRPTCLN(DATE1,DATE2,MATCH,NOMATCH,(NOMATCH/MATCH))
Q Y
;
EOJ ;
K XDRDOB,XDRDOB2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRPTDOB 1017 printed Oct 16, 2024@18:40:20 Page 2
XDRPTDOB ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES DATE OF BIRTHS; ;1/27/97 15:11
+1 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
+2 ;;
START ;
+1 DO INIT
EN ; EP - Entry point for comparing dates
+1 DO COMPARE
END DO EOJ
+1 QUIT
+2 ;
INIT ;
+1 KILL XDRDOB,XDRDOB2
+2 SET XDRDOB=XDRCD(XDRFL,XDRCD,.03,"I")
SET XDRDOB2=XDRCD2(XDRFL,XDRCD2,.03,"I")
+3 SET XDRDOB("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)
+4 SET XDRDOB("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)
+5 QUIT
+6 ;
COMPARE ;
+1 SET XDRD("TEST SCORE")=$$DATECOMP(XDRDOB,XDRDOB2,XDRDOB("MATCH"),XDRDOB("NO MATCH"),.8,.6)
+2 QUIT
+3 ;
DATECOMP(DATE1,DATE2,MATCH,NOMATCH,VAL1,VAL2) ;
+1 NEW Y
+2 SET Y=$$NUMCOMP^XDRPTCLN(DATE1,DATE2,MATCH,NOMATCH,VAL1)
+3 IF Y=NOMATCH
Begin DoDot:1
+4 IF $EXTRACT(DATE1,4,5)="00"!($EXTRACT(DATE2,4,5)="00")
SET DATE1=$EXTRACT(DATE1,1,3)_"0000"
SET DATE2=$EXTRACT(DATE2,1,3)_"0000"
SET MATCH=VAL2*MATCH
+5 IF $EXTRACT(DATE1,4,5)'="00"
IF $EXTRACT(DATE1,6,7)="00"!($EXTRACT(DATE2,6,7)="00")
SET DATE1=$EXTRACT(DATE1,1,5)_"00"
SET DATE2=$EXTRACT(DATE2,1,5)_"00"
SET MATCH=VAL1*MATCH
+6 SET Y=$$NUMCOMP^XDRPTCLN(DATE1,DATE2,MATCH,NOMATCH,(NOMATCH/MATCH))
End DoDot:1
+7 QUIT Y
+8 ;
EOJ ;
+1 KILL XDRDOB,XDRDOB2
+2 QUIT
