- 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
