- DPTDN ; IHS/TUCSON/JCM - COMPARES NAMES ;
- ;;1.0;PATIENT MERGE;;FEB 02, 1994
- ;
- ; Calls: SOU^DICM1
- ;
- START ;
- D INIT
- D NAME
- I $O(^DPT(XDRCD,.01,0)) D OTHER
- END D EOJ
- Q
- ;
- EN ; EP - Entry Point for any routines comparing names
- ;
- D INIT1
- D COMPARE
- D EOJ
- Q
- ;
- INIT ;
- D EOJ
- S DPTDN("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
- S DPTDN("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
- S DPTDN=$G(XDRCD(XDRFL,XDRCD,.01,"I")),DPTDN2=$G(XDRCD2(XDRFL,XDRCD2,.01,"I"))
- ;
- INIT1 S DPTDNL=$P(DPTDN,","),DPTDNF=$P($P(DPTDN,",",2)," "),DPTDNFI=$E(DPTDNF),DPTDNM=$P($P(DPTDN,",",2)," ",2),DPTDNMI=$E(DPTDNM)
- ;
- INIT2 S DPTDNL2=$P(DPTDN2,","),DPTDNF2=$P($P(DPTDN2,",",2)," "),DPTDNFI2=$E(DPTDNF2),DPTDNM2=$P($P(DPTDN2,",",2)," ",2),DPTDNMI2=$E(DPTDNM2)
- Q
- ;
- NAME ;
- D COMPARE
- D:$O(^DPT(XDRCD2,.01,0)) OTHER2
- Q
- ;
- OTHER ;
- F DPTDNO=0:0 S DPTDNO=$O(^DPT(XDRCD,.01,DPTDNO)) Q:'DPTDNO S DPTDN=$P(^DPT(XDRCD,.01,DPTDNO,0),U,1) S:'$D(DPTDN2) DPTDN2=XDRCD2(XDRFL,XDRCD2,.01,"I") D INIT1,NAME
- Q
- ;
- OTHER2 ;
- F DPTDNO2=0:0 S DPTDNO2=$O(^DPT(XDRCD2,.01,DPTDNO2)) Q:'DPTDNO2 S DPTDN2=$P(^DPT(XDRCD2,.01,DPTDNO2,0),U,1) D INIT2,COMPARE
- Q
- ;
- COMPARE ;
- S:'$D(DPTDN("TEST SCORE")) DPTDN("TEST SCORE")=DPTDN("NO MATCH")
- I DPTDN=DPTDN2 S DPTDN("TEST SCORE2")=DPTDN("MATCH") G COMPAREX
- I DPTDNF=DPTDNF2,DPTDNL=DPTDNL2 S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.8 G COMPAREX
- I DPTDNFI=DPTDNFI2,DPTDNL=DPTDNL2 S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6 G COMPAREX
- I DPTDNL=DPTDNL2 S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.4 G COMPAREX
- S X=DPTDNL D SOU^DICM1 S DPTDNLS=X S X=DPTDNL2 D SOU^DICM1 S DPTDNL2S=X
- S X=DPTDNF D SOU^DICM1 S DPTDNFS=X S X=DPTDNF2 D SOU^DICM1 S DPTDNF2S=X
- I DPTDNLS=DPTDNL2S,DPTDNFS=DPTDNF2S S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6 G COMPAREX
- I DPTDNFS=DPTDNF2S S DPTDN("TEST SCORE2")=DPTDN("MATCH")*.2 G COMPAREX
- S DPTDN("TEST SCORE2")=DPTDN("NO MATCH")
- COMPAREX ;
- S:DPTDN("TEST SCORE2")>(DPTDN("TEST SCORE")) DPTDN("TEST SCORE")=DPTDN("TEST SCORE2")
- K X,DPTDNLS,DPTDNL2S,DPTDNFS,DPTDNF2S,DPTDN("TEST SCORE2")
- Q
- ;
- EOJ ;
- S:$D(DPTDN("TEST SCORE")) XDRD("TEST SCORE")=DPTDN("TEST SCORE")
- K DPTDN,DPTDN2,DPTDNF,DPTDNF2,DPTDNL,DPTDNL2,DPTDNM,DPTDNM2
- K DPTDNMI,DPTDNMI2,DPTDNFI,DPTDNFI2,DPTDNO,DPTDNO2
- Q
- DPTDN ; IHS/TUCSON/JCM - COMPARES NAMES ;
- +1 ;;1.0;PATIENT MERGE;;FEB 02, 1994
- +2 ;
- +3 ; Calls: SOU^DICM1
- +4 ;
- START ;
- +1 DO INIT
- +2 DO NAME
- +3 IF $ORDER(^DPT(XDRCD,.01,0))
- DO OTHER
- END DO EOJ
- +1 QUIT
- +2 ;
- EN ; EP - Entry Point for any routines comparing names
- +1 ;
- +2 DO INIT1
- +3 DO COMPARE
- +4 DO EOJ
- +5 QUIT
- +6 ;
- INIT ;
- +1 DO EOJ
- +2 SET DPTDN("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)
- +3 SET DPTDN("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)
- +4 SET DPTDN=$GET(XDRCD(XDRFL,XDRCD,.01,"I"))
- SET DPTDN2=$GET(XDRCD2(XDRFL,XDRCD2,.01,"I"))
- +5 ;
- INIT1 SET DPTDNL=$PIECE(DPTDN,",")
- SET DPTDNF=$PIECE($PIECE(DPTDN,",",2)," ")
- SET DPTDNFI=$EXTRACT(DPTDNF)
- SET DPTDNM=$PIECE($PIECE(DPTDN,",",2)," ",2)
- SET DPTDNMI=$EXTRACT(DPTDNM)
- +1 ;
- INIT2 SET DPTDNL2=$PIECE(DPTDN2,",")
- SET DPTDNF2=$PIECE($PIECE(DPTDN2,",",2)," ")
- SET DPTDNFI2=$EXTRACT(DPTDNF2)
- SET DPTDNM2=$PIECE($PIECE(DPTDN2,",",2)," ",2)
- SET DPTDNMI2=$EXTRACT(DPTDNM2)
- +1 QUIT
- +2 ;
- NAME ;
- +1 DO COMPARE
- +2 IF $ORDER(^DPT(XDRCD2,.01,0))
- DO OTHER2
- +3 QUIT
- +4 ;
- OTHER ;
- +1 FOR DPTDNO=0:0
- SET DPTDNO=$ORDER(^DPT(XDRCD,.01,DPTDNO))
- IF 'DPTDNO
- QUIT
- SET DPTDN=$PIECE(^DPT(XDRCD,.01,DPTDNO,0),U,1)
- IF '$DATA(DPTDN2)
- SET DPTDN2=XDRCD2(XDRFL,XDRCD2,.01,"I")
- DO INIT1
- DO NAME
- +2 QUIT
- +3 ;
- OTHER2 ;
- +1 FOR DPTDNO2=0:0
- SET DPTDNO2=$ORDER(^DPT(XDRCD2,.01,DPTDNO2))
- IF 'DPTDNO2
- QUIT
- SET DPTDN2=$PIECE(^DPT(XDRCD2,.01,DPTDNO2,0),U,1)
- DO INIT2
- DO COMPARE
- +2 QUIT
- +3 ;
- COMPARE ;
- +1 IF '$DATA(DPTDN("TEST SCORE"))
- SET DPTDN("TEST SCORE")=DPTDN("NO MATCH")
- +2 IF DPTDN=DPTDN2
- SET DPTDN("TEST SCORE2")=DPTDN("MATCH")
- GOTO COMPAREX
- +3 IF DPTDNF=DPTDNF2
- IF DPTDNL=DPTDNL2
- SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.8
- GOTO COMPAREX
- +4 IF DPTDNFI=DPTDNFI2
- IF DPTDNL=DPTDNL2
- SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6
- GOTO COMPAREX
- +5 IF DPTDNL=DPTDNL2
- SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.4
- GOTO COMPAREX
- +6 SET X=DPTDNL
- DO SOU^DICM1
- SET DPTDNLS=X
- SET X=DPTDNL2
- DO SOU^DICM1
- SET DPTDNL2S=X
- +7 SET X=DPTDNF
- DO SOU^DICM1
- SET DPTDNFS=X
- SET X=DPTDNF2
- DO SOU^DICM1
- SET DPTDNF2S=X
- +8 IF DPTDNLS=DPTDNL2S
- IF DPTDNFS=DPTDNF2S
- SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.6
- GOTO COMPAREX
- +9 IF DPTDNFS=DPTDNF2S
- SET DPTDN("TEST SCORE2")=DPTDN("MATCH")*.2
- GOTO COMPAREX
- +10 SET DPTDN("TEST SCORE2")=DPTDN("NO MATCH")
- COMPAREX ;
- +1 IF DPTDN("TEST SCORE2")>(DPTDN("TEST SCORE"))
- SET DPTDN("TEST SCORE")=DPTDN("TEST SCORE2")
- +2 KILL X,DPTDNLS,DPTDNL2S,DPTDNFS,DPTDNF2S,DPTDN("TEST SCORE2")
- +3 QUIT
- +4 ;
- EOJ ;
- +1 IF $DATA(DPTDN("TEST SCORE"))
- SET XDRD("TEST SCORE")=DPTDN("TEST SCORE")
- +2 KILL DPTDN,DPTDN2,DPTDNF,DPTDNF2,DPTDNL,DPTDNL2,DPTDNM,DPTDNM2
- +3 KILL DPTDNMI,DPTDNMI2,DPTDNFI,DPTDNFI2,DPTDNO,DPTDNO2
- +4 QUIT
