XBPATC.m

XBPATC ; IHS/ADC/GTH - CHECK PATIENT GLOBALS ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; $O thru the PATIENT and 3RD party globals looking for missing entries

 ;

 ; Thanks to Robert F. Dolan for the original routine.

 ;

ST ;

 W !,"I WILL $O THRU THE PATIENT GLOBALS LOOKING FOR UNEQUAL DFN"

 W !,"AS UNEQUAL DFN ARE FOUND THE DFN WILL BE DISPLAYED"

 W !,"YOU SHOULD USE A SLAVE PRINTER FOR THIS RUN, AS THE SCREEN WILL SCROLL AND YOU WILL LOSE NEEDED INFORMATION",!

 Q:'$$DIR^XBDIR("E")

 S (CNT,CNT1,CNT2,CNT3)=0,U="^"

 W !,"LOOPING THROUGH THE IHS PATIENT GLOBAL",!

LOOP ;

 S DFN=0

 F  S DFN=$O(^AUPNPAT(DFN)) Q:DFN?.A  W "I" D:'$D(^DPT(DFN)) PRT

LOOP1 ;

 W !,"LOOPING THROUGH THE VA PATIENT GLOBAL",!

 S DFN=0

 F  S DFN=$O(^DPT(DFN)) Q:DFN?.A  W "V" D:'$D(^AUPNPAT(DFN)) PRT1

LOOP2 ;

 W !,"LOOPING THROUGH THE MEDICARE GLOBAL",!

 S DFN=0

 F  S DFN=$O(^AUPNMCR(DFN)) Q:DFN?.A  W "M" D:'$D(^AUPNPAT(DFN)) PRT2

LOOP3 ;

 W !,"LOOPING THROUGH THE MEDICAID GLOBAL",!

 S (DFN,DA)=0

 F  S DA=$O(^AUPNMCD(DA)) Q:DA?.A  D

 . S DFN=$P(^AUPNMCD(DA,0),U,1)

 . W "D"

 . I DFN="" D PRT3 Q

 . D:'$D(^AUPNPAT(DFN)) PRT2

 .Q

LOOP4 ;

 W !,"LOOPING THROUGH THE RAILROAD GLOBAL",!

 S DFN=0

 F  S DFN=$O(^AUPNRRE(DFN)) Q:DFN?.A  W "R" D:'$D(^AUPNPAT(DFN)) PRT2

LOOP5 ;

 W !,"LOOPING THROUGH THE PRIVATE INSURANCE GLOBAL",!

 S DFN=0

 F  S DFN=$O(^AUPNPRVT(DFN)) Q:DFN?.A  W "P" D:'$D(^AUPNPAT(DFN)) PRT2

EXIT ;

 W !!,"**E N D  O F  R U N **"

 W !,"NUMBER OF DFN NOT IN DPT=",CNT

 W !,"NUMBER OF DFN NOT IN AUPNPAT=",CNT1

 W !,"NUMBER OF 3RD PARTY DFN's NOT IN AUPNPAT=",CNT2

 W !,"NUMBER OF MEDICAID RECORDES WITH BAD DFN=",CNT3

 KILL CNT,CNT1,CNT2,CNT3,AZHDNUM

 Q

 ;

PRT ;PRINT FOR ENTRIES IN AUPNPAT NOT IN DPT

 W !!,"ENTRY IN AUPNPAT NOT IN DPT, DFN=",DFN

 S CNT=CNT+1

 Q

 ;

PRT1 ;PRINT FOR ENTRIES IN DPT NOT IN AUPNPAT

 W !!,"ENTRY IN DPT NOT IN AUPNPAT, DFN=",DFN

 S CNT1=CNT1+1

 Q

PRT2 ;PRINT FOR ENTRIES IN 3RD PARTY FILES BUT NOT IN AUPNPAT

 W !!,"ENTRY IN 3RD PARTY FILE NOT IN AUPNPAT, DFN=",DFN

 S CNT2=CNT2+1

 Q

PRT3 ;PRINT FOR ENTRIES IN MEDICAID GLOBAL BUT NOT IN AUPNPAT OR POINTER NOT VALID

 W !!,"ENTRY IN MEDICAID GLOBAL BUT DFN INVALID, DA=",DA,!

 S CNT3=CNT3+1

 Q

 ;

XBPATC    ; IHS/ADC/GTH - CHECK PATIENT GLOBALS ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; $O thru the PATIENT and 3RD party globals looking for missing entries

 +4       ;

 +5       ; Thanks to Robert F. Dolan for the original routine.

 +6       ;

ST        ;

 +1        WRITE !,"I WILL $O THRU THE PATIENT GLOBALS LOOKING FOR UNEQUAL DFN"

 +2        WRITE !,"AS UNEQUAL DFN ARE FOUND THE DFN WILL BE DISPLAYED"

 +3        WRITE !,"YOU SHOULD USE A SLAVE PRINTER FOR THIS RUN, AS THE SCREEN WILL SCROLL AND YOU WILL LOSE NEEDED INFORMATION",!

 +4        IF '$$DIR^XBDIR("E")

               QUIT 

 +5        SET (CNT,CNT1,CNT2,CNT3)=0

           SET U="^"

 +6        WRITE !,"LOOPING THROUGH THE IHS PATIENT GLOBAL",!

LOOP      ;

 +1        SET DFN=0

 +2        FOR 

               SET DFN=$ORDER(^AUPNPAT(DFN))

               IF DFN?.A

                   QUIT 

               WRITE "I"

               IF '$DATA(^DPT(DFN))

                   DO PRT

LOOP1     ;

 +1        WRITE !,"LOOPING THROUGH THE VA PATIENT GLOBAL",!

 +2        SET DFN=0

 +3        FOR 

               SET DFN=$ORDER(^DPT(DFN))

               IF DFN?.A

                   QUIT 

               WRITE "V"

               IF '$DATA(^AUPNPAT(DFN))

                   DO PRT1

LOOP2     ;

 +1        WRITE !,"LOOPING THROUGH THE MEDICARE GLOBAL",!

 +2        SET DFN=0

 +3        FOR 

               SET DFN=$ORDER(^AUPNMCR(DFN))

               IF DFN?.A

                   QUIT 

               WRITE "M"

               IF '$DATA(^AUPNPAT(DFN))

                   DO PRT2

LOOP3     ;

 +1        WRITE !,"LOOPING THROUGH THE MEDICAID GLOBAL",!

 +2        SET (DFN,DA)=0

 +3        FOR 

               SET DA=$ORDER(^AUPNMCD(DA))

               IF DA?.A

                   QUIT 

               Begin DoDot:1

 +4                SET DFN=$PIECE(^AUPNMCD(DA,0),U,1)

 +5                WRITE "D"

 +6                IF DFN=""

                       DO PRT3

                       QUIT 

 +7                IF '$DATA(^AUPNPAT(DFN))

                       DO PRT2

 +8                QUIT 

               End DoDot:1

LOOP4     ;

 +1        WRITE !,"LOOPING THROUGH THE RAILROAD GLOBAL",!

 +2        SET DFN=0

 +3        FOR 

               SET DFN=$ORDER(^AUPNRRE(DFN))

               IF DFN?.A

                   QUIT 

               WRITE "R"

               IF '$DATA(^AUPNPAT(DFN))

                   DO PRT2

LOOP5     ;

 +1        WRITE !,"LOOPING THROUGH THE PRIVATE INSURANCE GLOBAL",!

 +2        SET DFN=0

 +3        FOR 

               SET DFN=$ORDER(^AUPNPRVT(DFN))

               IF DFN?.A

                   QUIT 

               WRITE "P"

               IF '$DATA(^AUPNPAT(DFN))

                   DO PRT2

EXIT      ;

 +1        WRITE !!,"**E N D  O F  R U N **"

 +2        WRITE !,"NUMBER OF DFN NOT IN DPT=",CNT

 +3        WRITE !,"NUMBER OF DFN NOT IN AUPNPAT=",CNT1

 +4        WRITE !,"NUMBER OF 3RD PARTY DFN's NOT IN AUPNPAT=",CNT2

 +5        WRITE !,"NUMBER OF MEDICAID RECORDES WITH BAD DFN=",CNT3

 +6        KILL CNT,CNT1,CNT2,CNT3,AZHDNUM

 +7        QUIT 

 +8       ;

PRT       ;PRINT FOR ENTRIES IN AUPNPAT NOT IN DPT

 +1        WRITE !!,"ENTRY IN AUPNPAT NOT IN DPT, DFN=",DFN

 +2        SET CNT=CNT+1

 +3        QUIT 

 +4       ;

PRT1      ;PRINT FOR ENTRIES IN DPT NOT IN AUPNPAT

 +1        WRITE !!,"ENTRY IN DPT NOT IN AUPNPAT, DFN=",DFN

 +2        SET CNT1=CNT1+1

 +3        QUIT 

PRT2      ;PRINT FOR ENTRIES IN 3RD PARTY FILES BUT NOT IN AUPNPAT

 +1        WRITE !!,"ENTRY IN 3RD PARTY FILE NOT IN AUPNPAT, DFN=",DFN

 +2        SET CNT2=CNT2+1

 +3        QUIT 

PRT3      ;PRINT FOR ENTRIES IN MEDICAID GLOBAL BUT NOT IN AUPNPAT OR POINTER NOT VALID

 +1        WRITE !!,"ENTRY IN MEDICAID GLOBAL BUT DFN INVALID, DA=",DA,!

 +2        SET CNT3=CNT3+1

 +3        QUIT 

 +4       ;