- XDRPTSSN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97 15:20
- ;;7.3;TOOLKIT;**23**;Apr 25, 1995
- ;;
- ;
- START ;
- I XDRCD(XDRFL,XDRCD,.09,"I")']""!(XDRCD2(XDRFL,XDRCD2,.09,"I")']"") G END
- D INIT
- D COMPARE
- END D EOJ
- Q
- ;
- INIT ;
- D EOJ
- S XDRDSSN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
- S XDRDSSN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
- S XDRDSN=XDRCD(XDRFL,XDRCD,.09,"I")
- I XDRDSN'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD)=""
- S XDRDSN2=XDRCD2(XDRFL,XDRCD2,.09,"I")
- I XDRDSN2'?9N.E S XDRDSN="",^XTMP("XDRERR","BADSSN",XDRCD2)=""
- S XDRDSNF=$E(XDRDSN,1,3),XDRDSN2F=$E(XDRDSN2,1,3)
- S XDRDSNS=$E(XDRDSN,4,5),XDRDSN2S=$E(XDRDSN2,4,5)
- S XDRDSNT=$E(XDRDSN,6,9),XDRDSN2T=$E(XDRDSN2,6,9)
- Q
- ;
- COMPARE ;
- I XDRDSN=""!(XDRDSN2="") G COMPAREX
- ; SKIP SSN'S IF THEY ARE PSEUDOS
- I $E(XDRDSN,10)="P"!($E(XDRDSN2,10)="P") G COMPAREX
- ; SKIP SSN'S IF THEY ARE NOT REAL (I.E., 00000NNNN)
- I $E(XDRDSN,1,5)="00000"!($E(XDRDSN2,1,5)="00000") G COMPAREX
- ; ADDED LOGIC TO DETERMINE IF ONLY ONE DIGIT IS CHANGED, OR TWO
- ; DIGITS SWITCHED
- ; THIS IS ASSIGNED THE MAXIMUM MATCH VALUE, AND LAST 4, ETC LESS.
- ;
- N N
- S N=$$NUMCOMP^XDRPTCLN(XDRDSN,XDRDSN2,XDRDSSN("MATCH"),XDRDSSN("NO MATCH"),1) I N=XDRDSSN("MATCH") S XDRD("TEST SCORE")=XDRDSSN("MATCH") G COMPAREX
- ;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH
- I XDRDSNT=XDRDSN2T D G COMPAREX
- . S XDRD("TEST SCORE")=.6*XDRDSSN("MATCH")
- . I $E($P(^DPT(XDRCD,0),U))=$E($P(^DPT(XDRCD2,0),U)) D
- . . S XDRD("TEST SCORE")=.8*XDRDSSN("MATCH")
- S XDRDSSN("CNT")=0
- I XDRDSNF=XDRDSN2F S XDRDSSN("CNT")=XDRDSSN("CNT")+1
- I XDRDSNS=XDRDSN2S S XDRDSSN("CNT")=XDRDSSN("CNT")+1
- I XDRDSSN("CNT")>1 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.4 K XDRDSSN("CNT") G COMPAREX
- ;
- ;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S
- S XDRDSSN("PCNT")=0
- 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
- I XDRDSSN("PCNT")'>2,XDRDSSN("CNT")>0 S XDRD("TEST SCORE")=XDRDSSN("MATCH")*.2 G COMPAREX
- ;
- ;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH
- S XDRD("TEST SCORE")=XDRDSSN("NO MATCH")
- COMPAREX ;
- Q
- ;
- EOJ ;
- K XDRDSN,XDRDSN2,XDRDSNF,XDRDSN2F,XDRDSNS,XDRDSN2S,XDRDSNT,XDRDSN2T
- K XDRDSSN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRPTSSN 2276 printed Mar 13, 2025@21:44:50 Page 2
- XDRPTSSN ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES SSN'S; ;1/27/97 15:20
- +1 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
- +2 ;;
- +3 ;
- START ;
- +1 IF XDRCD(XDRFL,XDRCD,.09,"I")']""!(XDRCD2(XDRFL,XDRCD2,.09,"I")']"")
- GOTO END
- +2 DO INIT
- +3 DO COMPARE
- END DO EOJ
- +1 QUIT
- +2 ;
- INIT ;
- +1 DO EOJ
- +2 SET XDRDSSN("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)
- +3 SET XDRDSSN("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)
- +4 SET XDRDSN=XDRCD(XDRFL,XDRCD,.09,"I")
- +5 IF XDRDSN'?9N.E
- SET XDRDSN=""
- SET ^XTMP("XDRERR","BADSSN",XDRCD)=""
- +6 SET XDRDSN2=XDRCD2(XDRFL,XDRCD2,.09,"I")
- +7 IF XDRDSN2'?9N.E
- SET XDRDSN=""
- SET ^XTMP("XDRERR","BADSSN",XDRCD2)=""
- +8 SET XDRDSNF=$EXTRACT(XDRDSN,1,3)
- SET XDRDSN2F=$EXTRACT(XDRDSN2,1,3)
- +9 SET XDRDSNS=$EXTRACT(XDRDSN,4,5)
- SET XDRDSN2S=$EXTRACT(XDRDSN2,4,5)
- +10 SET XDRDSNT=$EXTRACT(XDRDSN,6,9)
- SET XDRDSN2T=$EXTRACT(XDRDSN2,6,9)
- +11 QUIT
- +12 ;
- COMPARE ;
- +1 IF XDRDSN=""!(XDRDSN2="")
- GOTO COMPAREX
- +2 ; SKIP SSN'S IF THEY ARE PSEUDOS
- +3 IF $EXTRACT(XDRDSN,10)="P"!($EXTRACT(XDRDSN2,10)="P")
- GOTO COMPAREX
- +4 ; SKIP SSN'S IF THEY ARE NOT REAL (I.E., 00000NNNN)
- +5 IF $EXTRACT(XDRDSN,1,5)="00000"!($EXTRACT(XDRDSN2,1,5)="00000")
- GOTO COMPAREX
- +6 ; ADDED LOGIC TO DETERMINE IF ONLY ONE DIGIT IS CHANGED, OR TWO
- +7 ; DIGITS SWITCHED
- +8 ; THIS IS ASSIGNED THE MAXIMUM MATCH VALUE, AND LAST 4, ETC LESS.
- +9 ;
- +10 NEW N
- +11 SET N=$$NUMCOMP^XDRPTCLN(XDRDSN,XDRDSN2,XDRDSSN("MATCH"),XDRDSSN("NO MATCH"),1)
- IF N=XDRDSSN("MATCH")
- SET XDRD("TEST SCORE")=XDRDSSN("MATCH")
- GOTO COMPAREX
- +12 ;CHECK TO SEE IF LAST FOUR MATCH OR TWO OF THREE PARTS MATCH
- +13 IF XDRDSNT=XDRDSN2T
- Begin DoDot:1
- +14 SET XDRD("TEST SCORE")=.6*XDRDSSN("MATCH")
- +15 IF $EXTRACT($PIECE(^DPT(XDRCD,0),U))=$EXTRACT($PIECE(^DPT(XDRCD2,0),U))
- Begin DoDot:2
- +16 SET XDRD("TEST SCORE")=.8*XDRDSSN("MATCH")
- End DoDot:2
- End DoDot:1
- GOTO COMPAREX
- +17 SET XDRDSSN("CNT")=0
- +18 IF XDRDSNF=XDRDSN2F
- SET XDRDSSN("CNT")=XDRDSSN("CNT")+1
- +19 IF XDRDSNS=XDRDSN2S
- SET XDRDSSN("CNT")=XDRDSSN("CNT")+1
- +20 IF XDRDSSN("CNT")>1
- SET XDRD("TEST SCORE")=XDRDSSN("MATCH")*.4
- KILL XDRDSSN("CNT")
- GOTO COMPAREX
- +21 ;
- +22 ;CHECK POSITIONAL RELATIONSHIP OF LAST FOUR DIGITS OF SSN'S
- +23 SET XDRDSSN("PCNT")=0
- +24 FOR XDRDSSN("I")=1:1:4
- if (XDRDSSN("PCNT")>2)
- QUIT
- IF $EXTRACT(XDRDSNT,XDRDSSN("I"))'=$EXTRACT(XDRDSN2T,XDRDSSN("I"))
- SET XDRDSSN("PCNT")=XDRDSSN("PCNT")+1
- +25 IF XDRDSSN("PCNT")'>2
- IF XDRDSSN("CNT")>0
- SET XDRD("TEST SCORE")=XDRDSSN("MATCH")*.2
- GOTO COMPAREX
- +26 ;
- +27 ;ASSIGN NEGATIVE VALUE FOR NO SSN MATCH
- +28 SET XDRD("TEST SCORE")=XDRDSSN("NO MATCH")
- COMPAREX ;
- +1 QUIT
- +2 ;
- EOJ ;
- +1 KILL XDRDSN,XDRDSN2,XDRDSNF,XDRDSN2F,XDRDSNS,XDRDSN2S,XDRDSNT,XDRDSN2T
- +2 KILL XDRDSSN
- +3 QUIT