XDRPTCLN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES CLAIM NUMBERS; ;4/18/97  11:04
 ;;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 XDRCLN,XDRCLN2
 S XDRCLN=$G(XDRCD(XDRFL,XDRCD,.313,"I")),XDRCLN2=$G(XDRCD2(XDRFL,XDRCD2,.313,"I"))
 S XDRCLN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
 S XDRCLN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
 Q
 ;
COMPARE ;
 S XDRD("TEST SCORE")=$$NUMCOMP(XDRCLN,XDRCLN2,XDRCLN("MATCH"),XDRCLN("NO MATCH"),.8)
 Q
 ;
NUMCOMP(VAL1,VAL2,MATCHVAL,NOMATCH,PARTIAL) ;
 I VAL1']""!(VAL2']"") Q 0
 I VAL1=VAL2 Q MATCHVAL
 I '$D(PARTIAL)!($G(PARTIAL)>1) S PARTIAL=.8
 N CNT,I,J,K  S CNT=0
 F I=1:1 Q:CNT>2  S J=$E(VAL1,I),K=$E(VAL2,I) Q:J=""&(K="")  I J'=K S CNT=CNT+1
 ; THE FOLLOWING CODE WAS ADDED TO IDENTIFY THOSE VALUES IN WHICH
 ; TWO ADJACENT DIGITS WERE TRANSPOSED
 I CNT=2 D
 . ;N C11,C12,C21,C22,X1,X2,A1,A2
 . S X1="",X2=""
 . F I=1:1 S A1=$E(VAL1,I),A2=$E(VAL2,I) Q:A1=""&(A2="")  I A1'=A2!(X1'="")!(X2'="") S X1=X1_A1,X2=X2_A2
 . S CNT=1
 . F I=2:1 S C12=$E(X1,I),C22=$E(X2,I) Q:C12=""&(C22="")  S C11=$E(X1,I-1),C21=$E(X2,I-1) I C12'=C22,C11'=C22!(C12'=C21) S CNT=2 Q
 Q $S(CNT>1:NOMATCH,1:(MATCHVAL*PARTIAL))
 ;
EOJ ;
 K XDRCLN,XDRCLN2
 Q