| 1 | XDRPTCLN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES CLAIM NUMBERS; ;4/18/97 11:04
|
|---|
| 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 XDRCLN,XDRCLN2
|
|---|
| 13 | S XDRCLN=$G(XDRCD(XDRFL,XDRCD,.313,"I")),XDRCLN2=$G(XDRCD2(XDRFL,XDRCD2,.313,"I"))
|
|---|
| 14 | S XDRCLN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
|
|---|
| 15 | S XDRCLN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | COMPARE ;
|
|---|
| 19 | S XDRD("TEST SCORE")=$$NUMCOMP(XDRCLN,XDRCLN2,XDRCLN("MATCH"),XDRCLN("NO MATCH"),.8)
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | NUMCOMP(VAL1,VAL2,MATCHVAL,NOMATCH,PARTIAL) ;
|
|---|
| 23 | I VAL1']""!(VAL2']"") Q 0
|
|---|
| 24 | I VAL1=VAL2 Q MATCHVAL
|
|---|
| 25 | I '$D(PARTIAL)!($G(PARTIAL)>1) S PARTIAL=.8
|
|---|
| 26 | N CNT,I,J,K S CNT=0
|
|---|
| 27 | 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
|
|---|
| 28 | ; THE FOLLOWING CODE WAS ADDED TO IDENTIFY THOSE VALUES IN WHICH
|
|---|
| 29 | ; TWO ADJACENT DIGITS WERE TRANSPOSED
|
|---|
| 30 | I CNT=2 D
|
|---|
| 31 | . ;N C11,C12,C21,C22,X1,X2,A1,A2
|
|---|
| 32 | . S X1="",X2=""
|
|---|
| 33 | . 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
|
|---|
| 34 | . S CNT=1
|
|---|
| 35 | . 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
|
|---|
| 36 | Q $S(CNT>1:NOMATCH,1:(MATCHVAL*PARTIAL))
|
|---|
| 37 | ;
|
|---|
| 38 | EOJ ;
|
|---|
| 39 | K XDRCLN,XDRCLN2
|
|---|
| 40 | Q
|
|---|
