| 1 | XDRPTDOB ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES DATE OF BIRTHS; ;1/27/97 15:11
|
|---|
| 2 | ;;7.3;TOOLKIT;**23**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | START ;
|
|---|
| 5 | D INIT
|
|---|
| 6 | EN ; EP - Entry point for comparing dates
|
|---|
| 7 | D COMPARE
|
|---|
| 8 | END D EOJ
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | INIT ;
|
|---|
| 12 | K XDRDOB,XDRDOB2
|
|---|
| 13 | S XDRDOB=XDRCD(XDRFL,XDRCD,.03,"I"),XDRDOB2=XDRCD2(XDRFL,XDRCD2,.03,"I")
|
|---|
| 14 | S XDRDOB("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
|
|---|
| 15 | S XDRDOB("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | COMPARE ;
|
|---|
| 19 | S XDRD("TEST SCORE")=$$DATECOMP(XDRDOB,XDRDOB2,XDRDOB("MATCH"),XDRDOB("NO MATCH"),.8,.6)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | DATECOMP(DATE1,DATE2,MATCH,NOMATCH,VAL1,VAL2) ;
|
|---|
| 23 | N Y
|
|---|
| 24 | S Y=$$NUMCOMP^XDRPTCLN(DATE1,DATE2,MATCH,NOMATCH,VAL1)
|
|---|
| 25 | I Y=NOMATCH D
|
|---|
| 26 | . 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
|
|---|
| 27 | . 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
|
|---|
| 28 | . S Y=$$NUMCOMP^XDRPTCLN(DATE1,DATE2,MATCH,NOMATCH,(NOMATCH/MATCH))
|
|---|
| 29 | Q Y
|
|---|
| 30 | ;
|
|---|
| 31 | EOJ ;
|
|---|
| 32 | K XDRDOB,XDRDOB2
|
|---|
| 33 | Q
|
|---|
