source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRPTDOB.m@ 1800

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

initial load of WorldVistAEHR

File size: 984 bytes
RevLine 
[613]1XDRPTDOB ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES DATE OF BIRTHS; ;1/27/97 15:11
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4START ;
5 D INIT
6EN ; EP - Entry point for comparing dates
7 D COMPARE
8END D EOJ
9 Q
10 ;
11INIT ;
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 ;
18COMPARE ;
19 S XDRD("TEST SCORE")=$$DATECOMP(XDRDOB,XDRDOB2,XDRDOB("MATCH"),XDRDOB("NO MATCH"),.8,.6)
20 Q
21 ;
22DATECOMP(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 ;
31EOJ ;
32 K XDRDOB,XDRDOB2
33 Q
Note: See TracBrowser for help on using the repository browser.