VistA-IHS-VA_UTILITIES-XB/XBPATC.m

70 lines
2.1 KiB
Mathematica
Raw Permalink Normal View History

XBPATC ; IHS/ADC/GTH - CHECK PATIENT GLOBALS ; [ 02/07/97 3:02 PM ]
;;4.0;XB;;Jul 20, 2009;Build 2
;
; $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
;