AGEDCHEK ;IHS/ITSC/TPF - USE TO REPORT ON BAD DATA IN ELIGIBILITY FILES
;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
;
Q
CHECKALL ;EP - CHECK FOR BAD ENTRIES FOR ALL KNOWN ELIGIBILITY DATA PROBLEMS
PRVT ;
W !,"CHECKING PRIVATE INSURANCE FILE"
S RECNO=0
F S RECNO=$O(^AUPNPRVT(RECNO)) Q:'RECNO D
. S D1=0
. F S D1=$O(^AUPNPRVT(RECNO,11,D1)) Q:'D1 D
.. I $P($G(^AUPNPRVT(RECNO,11,D1,0)),U)="" W !,RECNO Q
.. I $P($G(^AUPNPRVT(RECNO,11,D1,0)),U,8)="" W !,RECNO," MISSING POLICY HOLDER" ;IHS/SD/TPF AG*7.1*1 9/6/2005
MCD ;
W !,"CHECKING MEDICAID FILE"
S RECNO=0
F S RECNO=$O(^AUPNMCD(RECNO)) Q:'RECNO D
.I $P($G(^AUPNMCD(RECNO,0)),U)="" W !,RECNO," 1ST PIECE MISSING" Q
.I $P($G(^AUPNMCD(RECNO,0)),U,2)="" W !,RECNO," 2ND PIECE MISSING"
.I $P($G(^AUPNMCD(RECNO,0)),U,4)="" W !,RECNO,"STATE FIELD MISSING" ;IHS/SD/TPF AG*7.1*1 9/6/2005
.S D1=0
.F S D1=$O(^AUPNMCD(RECNO,11,D1)) Q:'D1 D
..I $P($G(^AUPNMCD(RECNO,11,D1,0)),U)="" W !?5,RECNO_"-"_D1
;CHECKING AB X-REF
W !,"CHECKING MEDICAID AB X-REF"
S DFN=""
F S DFN=$O(^AUPNMCD("AB",DFN)) Q:DFN="" D
.S ST="" F S ST=$O(^AUPNMCD("AB",DFN,ST)) Q:ST="" D
..S MCDNUM="" F S MCDNUM=$O(^AUPNMCD("AB",DFN,ST,MCDNUM)) Q:MCDNUM="" D
...S RECNO="" F S RECNO=$O(^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO)) Q:RECNO="" D
....I $P($G(^AUPNMCD(RECNO,0)),U)="" W !,"AB X-REF ",DFN,"-",RECNO
;
RRE ;
W !,"CHECKING RAILROAD FILE B X-REF"
S RECNO=""
F S RECNO=$O(^AUPNRRE("B",RECNO)) Q:'RECNO D
.I $P($G(^AUPNRRE(RECNO,0)),U)="" W !,RECNO
S RECNO=0
W !,"CHECKING RAILROAD ELIG DATES"
F S RECNO=$O(^AUPNRRE(RECNO)) Q:'RECNO D
.S D1=0
.F S D1=$O(^AUPNRRE(RECNO,11,D1)) Q:'D1 D
..I $P($G(^AUPNRRE(RECNO,11,D1,0)),U)="" W !,RECNO
MCR ;
W !,"CHECKING MEDICARE FILE B X-REF"
S RECNO=""
F S RECNO=$O(^AUPNMCR("B",RECNO)) Q:'RECNO D
.I $P($G(^AUPNMCR(RECNO,0)),U)="" W !,RECNO Q
S RECNO=0
W !,"CHECKING MEDICARE ELIG DATES"
F S RECNO=$O(^AUPNMCR(RECNO)) Q:'RECNO D
.I '$D(^AUPNMCR("B",RECNO)) W !,"MISSING B X-REF ",RECNO
.S D1=0
.F S D1=$O(^AUPNMCR(RECNO,11,D1)) Q:'D1 D
..I $P($G(^AUPNMCR(RECNO,11,D1,0)),U)="" W !,RECNO
;
INS ;
W !,"CHECKING INSURER FILE FOR DATE/TIME FIELD AS IEN"
S RECNO=0
F S RECNO=$O(^AUTNINS(RECNO)) Q:'RECNO D
.I RECNO[(".") W !,RECNO
W !,"CHECKING B X-REF WITH RECORD AND NO .01 FIELD"
S RECNO=""
F S RECNO=$O(^AUTNINS("B",RECNO)) Q:RECNO="" D
.S RECIEN=""
.F S RECIEN=$O(^AUTNINS("B",RECNO,RECIEN)) Q:RECIEN="" D
..I $P($G(^AUTNINS(RECIEN,0)),U)="" W !,RECIEN
;
PAT ;
W !,"CHECKING PATIENT FILE FOR MISSING .01 FIELD"
S RECNO=0
F S RECNO=$O(^AUPNPAT(RECNO)) Q:'RECNO D
.I $P($G(^AUPNPAT(RECNO,0)),U)="" W !,RECNO
;
W !,"CHECKING FOR ""D"" X-REF WITH NO PARENT RECORD"
S HRN="" F S HRN=$O(^AUPNPAT("D",HRN)) Q:HRN="" D
.S RECNO="" F S RECNO=$O(^AUPNPAT("D",HRN,RECNO)) Q:RECNO="" D
..I '$D(^AUPNPAT(RECNO))!('$D(^DPT(RECNO))) W !,RECNO,"*",HRN
Q
TPLCNV ;
S RECNO=0
F S RECNO=$O(^AUPNAUTO(RECNO)) Q:'RECNO D
.S INSPTR=$P($G(^AUPNAUTO(RECNO,0)),U,4)
.Q:INSPTR'=""
.I INSPTR="" W !,"MISSING INSURER PTR "_RECNO
.S PTPTR=$P($G(^AUPNAUTO(RECNO,0)),U,2)
.S ACCDT=$P($G(^AUPNAUTO(RECNO,1)),U,2)
.I PTPTR="" W !?5,"MISSING PTPTR AT "_RECNO Q
.I '$O(^AUPNTPL(PTPTR,1,0)),(ACCDT'="") W !?5,"MISSING DATE TRANSFER FROM AUTO "_RECNO_" TO TPL AT "_PTPTR_"|"_ACCDT
.S DTIEN=""
.F S DTIEN=$O(^AUPNTPL(PTPTR,1,DTIEN)) Q:'DTIEN D
..S INSPTR=$P($G(^AUPNTPL(PTPTR,1,DTIEN,0)),U,2)
..I INSPTR=1 W !?5,"RRE PTR FOUND"_PTPTR_"|"_DTIEN
..I INSPTR="" W !?5,"NULL PTR FOUND",PTPTR_"|"_DTIEN
Q
TPLFIX ;
S IEN=0
F S IEN=$O(^AUPNTPL(IEN)) Q:'IEN D
.S DTIEN=0
.F S DTIEN=$O(^AUPNTPL(IEN,1,DTIEN)) Q:'DTIEN D
..I $P($G(^AUPNTPL(IEN,1,DTIEN,0)),U,2)=1 S $P(^AUPNTPL(IEN,1,DTIEN,0),U,2)=""
Q
AGEDCHEK ;IHS/ITSC/TPF - USE TO REPORT ON BAD DATA IN ELIGIBILITY FILES
+1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
+2 ;
+3 QUIT
CHECKALL ;EP - CHECK FOR BAD ENTRIES FOR ALL KNOWN ELIGIBILITY DATA PROBLEMS
PRVT ;
+1 WRITE !,"CHECKING PRIVATE INSURANCE FILE"
+2 SET RECNO=0
+3 FOR
SET RECNO=$ORDER(^AUPNPRVT(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 SET D1=0
+5 FOR
SET D1=$ORDER(^AUPNPRVT(RECNO,11,D1))
IF 'D1
QUIT
Begin DoDot:2
+6 IF $PIECE($GET(^AUPNPRVT(RECNO,11,D1,0)),U)=""
WRITE !,RECNO
QUIT
+7 ;IHS/SD/TPF AG*7.1*1 9/6/2005
IF $PIECE($GET(^AUPNPRVT(RECNO,11,D1,0)),U,8)=""
WRITE !,RECNO," MISSING POLICY HOLDER"
End DoDot:2
End DoDot:1
MCD ;
+1 WRITE !,"CHECKING MEDICAID FILE"
+2 SET RECNO=0
+3 FOR
SET RECNO=$ORDER(^AUPNMCD(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNMCD(RECNO,0)),U)=""
WRITE !,RECNO," 1ST PIECE MISSING"
QUIT
+5 IF $PIECE($GET(^AUPNMCD(RECNO,0)),U,2)=""
WRITE !,RECNO," 2ND PIECE MISSING"
+6 ;IHS/SD/TPF AG*7.1*1 9/6/2005
IF $PIECE($GET(^AUPNMCD(RECNO,0)),U,4)=""
WRITE !,RECNO,"STATE FIELD MISSING"
+7 SET D1=0
+8 FOR
SET D1=$ORDER(^AUPNMCD(RECNO,11,D1))
IF 'D1
QUIT
Begin DoDot:2
+9 IF $PIECE($GET(^AUPNMCD(RECNO,11,D1,0)),U)=""
WRITE !?5,RECNO_"-"_D1
End DoDot:2
End DoDot:1
+10 ;CHECKING AB X-REF
+11 WRITE !,"CHECKING MEDICAID AB X-REF"
+12 SET DFN=""
+13 FOR
SET DFN=$ORDER(^AUPNMCD("AB",DFN))
IF DFN=""
QUIT
Begin DoDot:1
+14 SET ST=""
FOR
SET ST=$ORDER(^AUPNMCD("AB",DFN,ST))
IF ST=""
QUIT
Begin DoDot:2
+15 SET MCDNUM=""
FOR
SET MCDNUM=$ORDER(^AUPNMCD("AB",DFN,ST,MCDNUM))
IF MCDNUM=""
QUIT
Begin DoDot:3
+16 SET RECNO=""
FOR
SET RECNO=$ORDER(^AUPNMCD("AB",DFN,ST,MCDNUM,RECNO))
IF RECNO=""
QUIT
Begin DoDot:4
+17 IF $PIECE($GET(^AUPNMCD(RECNO,0)),U)=""
WRITE !,"AB X-REF ",DFN,"-",RECNO
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
RRE ;
+1 WRITE !,"CHECKING RAILROAD FILE B X-REF"
+2 SET RECNO=""
+3 FOR
SET RECNO=$ORDER(^AUPNRRE("B",RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNRRE(RECNO,0)),U)=""
WRITE !,RECNO
End DoDot:1
+5 SET RECNO=0
+6 WRITE !,"CHECKING RAILROAD ELIG DATES"
+7 FOR
SET RECNO=$ORDER(^AUPNRRE(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+8 SET D1=0
+9 FOR
SET D1=$ORDER(^AUPNRRE(RECNO,11,D1))
IF 'D1
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^AUPNRRE(RECNO,11,D1,0)),U)=""
WRITE !,RECNO
End DoDot:2
End DoDot:1
MCR ;
+1 WRITE !,"CHECKING MEDICARE FILE B X-REF"
+2 SET RECNO=""
+3 FOR
SET RECNO=$ORDER(^AUPNMCR("B",RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNMCR(RECNO,0)),U)=""
WRITE !,RECNO
QUIT
End DoDot:1
+5 SET RECNO=0
+6 WRITE !,"CHECKING MEDICARE ELIG DATES"
+7 FOR
SET RECNO=$ORDER(^AUPNMCR(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+8 IF '$DATA(^AUPNMCR("B",RECNO))
WRITE !,"MISSING B X-REF ",RECNO
+9 SET D1=0
+10 FOR
SET D1=$ORDER(^AUPNMCR(RECNO,11,D1))
IF 'D1
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^AUPNMCR(RECNO,11,D1,0)),U)=""
WRITE !,RECNO
End DoDot:2
End DoDot:1
+12 ;
INS ;
+1 WRITE !,"CHECKING INSURER FILE FOR DATE/TIME FIELD AS IEN"
+2 SET RECNO=0
+3 FOR
SET RECNO=$ORDER(^AUTNINS(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 IF RECNO[(".")
WRITE !,RECNO
End DoDot:1
+5 WRITE !,"CHECKING B X-REF WITH RECORD AND NO .01 FIELD"
+6 SET RECNO=""
+7 FOR
SET RECNO=$ORDER(^AUTNINS("B",RECNO))
IF RECNO=""
QUIT
Begin DoDot:1
+8 SET RECIEN=""
+9 FOR
SET RECIEN=$ORDER(^AUTNINS("B",RECNO,RECIEN))
IF RECIEN=""
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^AUTNINS(RECIEN,0)),U)=""
WRITE !,RECIEN
End DoDot:2
End DoDot:1
+11 ;
PAT ;
+1 WRITE !,"CHECKING PATIENT FILE FOR MISSING .01 FIELD"
+2 SET RECNO=0
+3 FOR
SET RECNO=$ORDER(^AUPNPAT(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNPAT(RECNO,0)),U)=""
WRITE !,RECNO
End DoDot:1
+5 ;
+6 WRITE !,"CHECKING FOR ""D"" X-REF WITH NO PARENT RECORD"
+7 SET HRN=""
FOR
SET HRN=$ORDER(^AUPNPAT("D",HRN))
IF HRN=""
QUIT
Begin DoDot:1
+8 SET RECNO=""
FOR
SET RECNO=$ORDER(^AUPNPAT("D",HRN,RECNO))
IF RECNO=""
QUIT
Begin DoDot:2
+9 IF '$DATA(^AUPNPAT(RECNO))!('$DATA(^DPT(RECNO)))
WRITE !,RECNO,"*",HRN
End DoDot:2
End DoDot:1
+10 QUIT
TPLCNV ;
+1 SET RECNO=0
+2 FOR
SET RECNO=$ORDER(^AUPNAUTO(RECNO))
IF 'RECNO
QUIT
Begin DoDot:1
+3 SET INSPTR=$PIECE($GET(^AUPNAUTO(RECNO,0)),U,4)
+4 IF INSPTR'=""
QUIT
+5 IF INSPTR=""
WRITE !,"MISSING INSURER PTR "_RECNO
+6 SET PTPTR=$PIECE($GET(^AUPNAUTO(RECNO,0)),U,2)
+7 SET ACCDT=$PIECE($GET(^AUPNAUTO(RECNO,1)),U,2)
+8 IF PTPTR=""
WRITE !?5,"MISSING PTPTR AT "_RECNO
QUIT
+9 IF '$ORDER(^AUPNTPL(PTPTR,1,0))
IF (ACCDT'="")
WRITE !?5,"MISSING DATE TRANSFER FROM AUTO "_RECNO_" TO TPL AT "_PTPTR_"|"_ACCDT
+10 SET DTIEN=""
+11 FOR
SET DTIEN=$ORDER(^AUPNTPL(PTPTR,1,DTIEN))
IF 'DTIEN
QUIT
Begin DoDot:2
+12 SET INSPTR=$PIECE($GET(^AUPNTPL(PTPTR,1,DTIEN,0)),U,2)
+13 IF INSPTR=1
WRITE !?5,"RRE PTR FOUND"_PTPTR_"|"_DTIEN
+14 IF INSPTR=""
WRITE !?5,"NULL PTR FOUND",PTPTR_"|"_DTIEN
End DoDot:2
End DoDot:1
+15 QUIT
TPLFIX ;
+1 SET IEN=0
+2 FOR
SET IEN=$ORDER(^AUPNTPL(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+3 SET DTIEN=0
+4 FOR
SET DTIEN=$ORDER(^AUPNTPL(IEN,1,DTIEN))
IF 'DTIEN
QUIT
Begin DoDot:2
+5 IF $PIECE($GET(^AUPNTPL(IEN,1,DTIEN,0)),U,2)=1
SET $PIECE(^AUPNTPL(IEN,1,DTIEN,0),U,2)=""
End DoDot:2
End DoDot:1
+6 QUIT
