Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XDRPTSSN

XDRPTSSN.m

Go to the documentation of this file.
  1. XDRPTSSN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97 15:20
  1. ;;7.3;TOOLKIT;**23**;Apr 25, 1995
  1. ;;
  1. ;
  1. START ;
  1. I XDRCD(XDRFL,XDRCD,.09,"I")']""!(XDRCD2(XDRFL,XDRCD2,.09,"I")']"") G END
  1. D INIT
  1. D COMPARE
  1. END D EOJ
  1. Q
  1. ;
  1. INIT ;
  1. D EOJ
  1. S XDRDSSN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
  1. S XDRDSSN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
  1. S XDRDSN=XDRCD(XDRFL,XDRCD,.09,"I")
  1. I XDRDSN'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD)=""
  1. S XDRDSN2=XDRCD2(XDRFL,XDRCD2,.09,"I")
  1. I XDRDSN2'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD2)=""
  1. S XDRDSNF=$E(XDRDSN,1,3),XDRDSN2F=$E(XDRDSN2,1,3)
  1. S XDRDSNS=$E(XDRDSN,4,5),XDRDSN2S=$E(XDRDSN2,4,5)
  1. S XDRDSNT=$E(XDRDSN,6,9),XDRDSN2T=$E(XDRDSN2,6,9)
  1. Q
  1. ;
  1. COMPARE ;
  1. I XDRDSN=""!(XDRDSN2="") G COMPAREX
  1. ; SKIP SSN'S IF THEY ARE PSEUDOS
  1. I $E(XDRDSN,10)="P"!($E(XDRDSN2,10)="P") G COMPAREX
  1. ; SKIP SSN'S IF THEY ARE NOT REAL (I.E., 00000NNNN)
  1. I $E(XDRDSN,1,5)="00000"!($E(XDRDSN2,1,5)="00000") G COMPAREX
  1. ; ADDED LOGIC TO DETERMINE IF ONLY ONE DIGIT IS CHANGED, OR TWO
  1. ; DIGITS SWITCHED
  1. ; THIS IS ASSIGNED THE MAXIMUM MATCH VALUE, AND LAST 4, ETC LESS.
  1. ;
  1. N N
  1. S N=$$NUMCOMP^XDRPTCLN(XDRDSN,XDRDSN2,XDRDSSN("MATCH"),XDRDSSN("NO MATCH"),1) I N=XDRDSSN("MATCH") S XDRD("TEST SCORE")=XDRDSSN("MATCH") G COMPAREX
  1. ;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH
  1. I XDRDSNT=XDRDSN2T D G COMPAREX
  1. . S XDRD("TEST SCORE")=.6*XDRDSSN("MATCH")
  1. . I $E($P(^DPT(XDRCD,0),U))=$E($P(^DPT(XDRCD2,0),U)) D
  1. . . S XDRD("TEST SCORE")=.8*XDRDSSN("MATCH")
  1. S XDRDSSN("CNT")=0
  1. I XDRDSNF=XDRDSN2F S XDRDSSN("CNT")=XDRDSSN("CNT")+1
  1. I XDRDSNS=XDRDSN2S S XDRDSSN("CNT")=XDRDSSN("CNT")+1
  1. I XDRDSSN("CNT")>1 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.4 K XDRDSSN("CNT") G COMPAREX
  1. ;
  1. ;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S
  1. S XDRDSSN("PCNT")=0
  1. F XDRDSSN("I")=1:1:4 Q:(XDRDSSN("PCNT")>2) I $E(XDRDSNT,XDRDSSN("I"))'=$E(XDRDSN2T,XDRDSSN("I")) S XDRDSSN("PCNT")=XDRDSSN("PCNT")+1
  1. I XDRDSSN("PCNT")'>2,XDRDSSN("CNT")>0 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.2 G COMPAREX
  1. ;
  1. ;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH
  1. S XDRD("TEST SCORE")=XDRDSSN("NO MATCH")
  1. COMPAREX ;
  1. Q
  1. ;
  1. EOJ ;
  1. K XDRDSN,XDRDSN2,XDRDSNF,XDRDSN2F,XDRDSNS,XDRDSN2S,XDRDSNT,XDRDSN2T
  1. K XDRDSSN
  1. Q