XDRPTDOB.m

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 ---XDRPTDOB   1017     printed  Apr 09, 2024@21:42:35                                                                                                                                                                                                    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