- 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
