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

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1XDRPTCLN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES CLAIM NUMBERS; ;4/18/97 11:04
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 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 ;
18COMPARE ;
19 S XDRD("TEST SCORE")=$$NUMCOMP(XDRCLN,XDRCLN2,XDRCLN("MATCH"),XDRCLN("NO MATCH"),.8)
20 Q
21 ;
22NUMCOMP(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 ;
38EOJ ;
39 K XDRCLN,XDRCLN2
40 Q
Note: See TracBrowser for help on using the repository browser.