BZXBPN ;IHS/PHXAO/AEF - FIND BAD PATIENT NAMES
;;1.0;ANNE'S SPECIAL ROUTINES;;JUNE 10, 2004
;
;The code in this routine was written by Jim Gray at PIMC.
;
BADPTNAM ;Find bad names
W !,"PATIENT NAME",?25,"MEDICAID NAME",?50,"MEDICARE NAME"
S DFN=0
F S DFN=$O(^DPT(DFN)) Q:'DFN D
.Q:'$D(^DPT(DFN,0))
.S BZXDONE=0
.S VIEN=0
.F S VIEN=$O(^AUPNVSIT("AC",DFN,VIEN)) Q:'VIEN D Q:BZXDONE
..Q:(+$G(^AUPNVSIT(VIEN,0)))<3020214
..S FLG=0
..K NAME,MCAIDNAM,MCARNAM
..S NAME=$P(^DPT(DFN,0),U,1)
..S BZXGOOD=$$CHKNAM(NAME)
..I BZXGOOD<1 W !,NAME S FLG=1
..S MCAIDIEN=0
..F S MCAIDIEN=$O(^AUPNMCD("B",DFN,MCAIDIEN)) Q:'MCAIDIEN D
...S MCAIDNAM=$P($G(^AUPNMCD(MCAIDIEN,21)),U,1)
...I $$CHKNAM(MCAIDNAM)<1 D
....I FLG=0 W !,NAME S FLG=1
....I (MCAIDNAM="")!(MCAIDNAM?1." ") S MCAIDNAM="BLANK"
....W ?25,MCAIDNAM
..I $D(^AUPNMCR(DFN,21)) D
...S MCARNAM=$P(^AUPNMCR(DFN,21),U,1)
...I $$CHKNAM(MCARNAM)<1 D
....I FLG=0 W !,NAME S FLG=1
....I (MCARNAM="")!(MCARNAM?1." ") S MCARNAM="BLANK"
....W ?50,MCARNAM
..S BZXDONE=1
Q
;
CHKNAM(NAM) ;CHECK NAME FORMAT
I NAM?2.A.1(1" ",1"-").A1" "1(1"JR",1"SR",1"II",1"III",1"IV",1"V")1","2.A.1" ".A.1"." Q -1 ;BAD
I NAM?2.A.1(1" ",1"-").A1","1.A.1" ".A.1".".1",".3A.1"." Q 1 ;GOOD
Q 0
;
BADADR ;Find bad addresses
S DFN=0
F S DFN=$O(^DPT(DFN)) Q:'DFN D
.Q:'$D(^DPT(DFN,0))
.S BZXDONE=0
.S VIEN=0
.F S VIEN=$O(^AUPNVSIT("AC",DFN,VIEN)) Q:'VIEN D Q:BZXDONE
..Q:(+$G(^AUPNVSIT(VIEN,0)))<3020214
..S BZXDONE=1
..S IENS=DFN_","
..S BZXGOOD=0
..S BZXADDR=$$GET1^DIQ(2,IENS,.111)
..Q:BZXADDR=""
..I BZXADDR?1.5N1" ".5AP.1" "3.NA.AP.N." " S BZXGOOD=1
..I BZXADDR?1"P".1".".1" "1"O".1".".1" ".1"BOX"1" ".1"#"1.8N S BZXGOOD=1
..Q:BZXGOOD
..S BZXPAT0=^DPT(DFN,0)
..S BZXPAT11=^DPT(DFN,.11)
..S NAME=$P(BZXPAT0,U,1)
..S SSN=$P(BZXPAT0,U,9)
..S ADDR2T3=$P(BZXPAT11,U,2,3)
..S CITY=$P(BZXPAT11,U,4)
..S STATE=$$GET1^DIQ(2,IENS,.115)
..S ZIP=$P(BZXPAT11,U,6)
..W !,NAME,?25,SSN
..W !,BZXADDR
..I $L(ADDR2T3)>1 W !,ADDR2T3
..W !,CITY_", "_STATE_" "_ZIP
..W !
Q
BZXBPN ;IHS/PHXAO/AEF - FIND BAD PATIENT NAMES
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;JUNE 10, 2004
+2 ;
+3 ;The code in this routine was written by Jim Gray at PIMC.
+4 ;
BADPTNAM ;Find bad names
+1 WRITE !,"PATIENT NAME",?25,"MEDICAID NAME",?50,"MEDICARE NAME"
+2 SET DFN=0
+3 FOR
SET DFN=$ORDER(^DPT(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+4 IF '$DATA(^DPT(DFN,0))
QUIT
+5 SET BZXDONE=0
+6 SET VIEN=0
+7 FOR
SET VIEN=$ORDER(^AUPNVSIT("AC",DFN,VIEN))
IF 'VIEN
QUIT
Begin DoDot:2
+8 IF (+$GET(^AUPNVSIT(VIEN,0)))<3020214
QUIT
+9 SET FLG=0
+10 KILL NAME,MCAIDNAM,MCARNAM
+11 SET NAME=$PIECE(^DPT(DFN,0),U,1)
+12 SET BZXGOOD=$$CHKNAM(NAME)
+13 IF BZXGOOD<1
WRITE !,NAME
SET FLG=1
+14 SET MCAIDIEN=0
+15 FOR
SET MCAIDIEN=$ORDER(^AUPNMCD("B",DFN,MCAIDIEN))
IF 'MCAIDIEN
QUIT
Begin DoDot:3
+16 SET MCAIDNAM=$PIECE($GET(^AUPNMCD(MCAIDIEN,21)),U,1)
+17 IF $$CHKNAM(MCAIDNAM)<1
Begin DoDot:4
+18 IF FLG=0
WRITE !,NAME
SET FLG=1
+19 IF (MCAIDNAM="")!(MCAIDNAM?1." ")
SET MCAIDNAM="BLANK"
+20 WRITE ?25,MCAIDNAM
End DoDot:4
End DoDot:3
+21 IF $DATA(^AUPNMCR(DFN,21))
Begin DoDot:3
+22 SET MCARNAM=$PIECE(^AUPNMCR(DFN,21),U,1)
+23 IF $$CHKNAM(MCARNAM)<1
Begin DoDot:4
+24 IF FLG=0
WRITE !,NAME
SET FLG=1
+25 IF (MCARNAM="")!(MCARNAM?1." ")
SET MCARNAM="BLANK"
+26 WRITE ?50,MCARNAM
End DoDot:4
End DoDot:3
+27 SET BZXDONE=1
End DoDot:2
IF BZXDONE
QUIT
End DoDot:1
+28 QUIT
+29 ;
CHKNAM(NAM) ;CHECK NAME FORMAT
+1 ;BAD
IF NAM?2.A.1(1" ",1"-").A1" "1(1"JR",1"SR",1"II",1"III",1"IV",1"V")1","2.A.1" ".A.1"."
QUIT -1
+2 ;GOOD
IF NAM?2.A.1(1" ",1"-").A1","1.A.1" ".A.1".".1",".3A.1"."
QUIT 1
+3 QUIT 0
+4 ;
BADADR ;Find bad addresses
+1 SET DFN=0
+2 FOR
SET DFN=$ORDER(^DPT(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+3 IF '$DATA(^DPT(DFN,0))
QUIT
+4 SET BZXDONE=0
+5 SET VIEN=0
+6 FOR
SET VIEN=$ORDER(^AUPNVSIT("AC",DFN,VIEN))
IF 'VIEN
QUIT
Begin DoDot:2
+7 IF (+$GET(^AUPNVSIT(VIEN,0)))<3020214
QUIT
+8 SET BZXDONE=1
+9 SET IENS=DFN_","
+10 SET BZXGOOD=0
+11 SET BZXADDR=$$GET1^DIQ(2,IENS,.111)
+12 IF BZXADDR=""
QUIT
+13 IF BZXADDR?1.5N1" ".5AP.1" "3.NA.AP.N." "
SET BZXGOOD=1
+14 IF BZXADDR?1"P".1".".1" "1"O".1".".1" ".1"BOX"1" ".1"#"1.8N
SET BZXGOOD=1
+15 IF BZXGOOD
QUIT
+16 SET BZXPAT0=^DPT(DFN,0)
+17 SET BZXPAT11=^DPT(DFN,.11)
+18 SET NAME=$PIECE(BZXPAT0,U,1)
+19 SET SSN=$PIECE(BZXPAT0,U,9)
+20 SET ADDR2T3=$PIECE(BZXPAT11,U,2,3)
+21 SET CITY=$PIECE(BZXPAT11,U,4)
+22 SET STATE=$$GET1^DIQ(2,IENS,.115)
+23 SET ZIP=$PIECE(BZXPAT11,U,6)
+24 WRITE !,NAME,?25,SSN
+25 WRITE !,BZXADDR
+26 IF $LENGTH(ADDR2T3)>1
WRITE !,ADDR2T3
+27 WRITE !,CITY_", "_STATE_" "_ZIP
+28 WRITE !
End DoDot:2
IF BZXDONE
QUIT
End DoDot:1
+29 QUIT
