PXQUTL3A ;ISL/JVS CLEAN OUT BAD XREF #2 ;4/16/97 14:30
;;1.0;PCE PATIENT CARE ENCOUNTER;**29,199**;Aug 12, 1996;Build 51
;
;
Q
;
V ;--------------VISIT FILE---------------------------------
W !!,"Checking the VISIT FILE #9000010 (VISITS)",!
S VSTCNT=0
I Y="^" Q
D Q
Q
AA ;-----------------AA-LEVEL 3------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('AA',"
W !!,"Checking the ^AUPNVSIT(""AA"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("AA",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("AA",I,IEN)) Q:IEN="" D
..S IENN="" F S IENN=$O(^AUPNVSIT("AA",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
...S ARRAY="^AUPNVSIT(""AA"",I,IEN,IENN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
...I '$D(^AUPNVSIT(IENN)) W !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AA"","_I_",",IEN_","_IENN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
AD ;-----------------AD-LEVEL 2------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('AD',"
W !!,"Checking the ^AUPNVSIT(""AD"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("AD",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVSIT(""AD"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
ADEL ;-----------------ADEL-LEVEL 2------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('ADEL',"
W !!,"Checking the ^AUPNVSIT(""ADEL"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("ADEL",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("ADEL",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVSIT(""ADEL"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""ADEL"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
AET ;-----------------AET-LEVEL 5------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('AET',"
W !!,"Checking the ^AUPNVSIT(""AET"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("AET",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("AET",I,IEN)) Q:IEN="" D
..S IENN="" F S IENN=$O(^AUPNVSIT("AET",I,IEN,IENN)) Q:IENN="" D
...S IENNN="" F S IENNN=$O(^AUPNVSIT("AET",I,IEN,IENN,IENNN)) Q:IENNN="" D
....S IENNNN="" F S IENNNN=$O(^AUPNVSIT("AET",I,IEN,IENN,IENNN,IENNNN)) W:IENNNN#1000=22 "." Q:IENNNN="" D
.....S ARRAY="^AUPNVSIT(""AET"",I,IEN,IENN,IENNN,IENNNN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
.....I '$D(^AUPNVSIT(IENNNN)) W !,"Entry "_IENNNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""AET"","_I_",",IEN_","_IENN_","_IENNN_","_IENNNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
AHL ;-----------------AHL-LEVEL 3------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('AHL',"
W !!,"Checking the ^AUPNVSIT(""AHL"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("AHL",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("AHL",I,IEN)) Q:IEN="" D
..S IENN="" F S IENN=$O(^AUPNVSIT("AHL",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
...S ARRAY="^AUPNVSIT(""AHL"",I,IEN,IENN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
...I '$D(^AUPNVSIT(IENN)) W !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AHL"","_I_",",IEN_","_IENN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
B ;-----------------B-LEVEL 2------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('B',"
W !!,"Checking the ^AUPNVSIT(""B"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("B",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVSIT(""B"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
C ;-----------------C-LEVEL 2------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('C',"
W !!,"Checking the ^AUPNVSIT(""C"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("C",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVSIT(""C"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
VID ;-----------------VID-LEVEL 2------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('VID',"
W !!,"Checking the ^AUPNVSIT(""VID"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("VID",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("VID",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVSIT(""VID"",I,IEN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""VID"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
Q
AAH ;-----------------AAH-LEVEL 3------------------------------
S VSTXCNT=0,XREF="^AUPNVSIT('AAH',"
W !!,"Checking the ^AUPNVSIT(""AAH"") X-REF",!
S I="" F S I=$O(^AUPNVSIT("AAH",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("AAH",I,IEN)) Q:IEN="" D
..S IENN="" F S IENN=$O(^AUPNVSIT("AAH",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
...S ARRAY="^AUPNVSIT(""AAH"",I,IEN,IENN)" S VSTCNT=VSTCNT+1,VSTXCNT=VSTXCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
...I '$D(^AUPNVSIT(IENN)) W !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AAH"","_I_",",IEN_","_IENN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
Q
;
;-------------------------------------------------------
S ;++--SCREEN FOR POSSIBLE BROKEN X REFERENCES
;--V PROVIDER FILE
S (VSTCNT,CPTCNT,PRVCNT,POVCNT)=0
W !!,"Screening the V PROVIDER file",!
S I="" F S I=$O(^AUPNVPRV("B",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVPRV("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVPRV(""B"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""B"","_I_",",IEN_")"
;
;--V POV FILE (DIAGNOSIS)
W !!,"Screening the V POV file (DIAGNOSIS)",!
S I="" F S I=$O(^AUPNVPOV("B",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVPOV("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVPOV(""B"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""B"","_I_",",IEN_")"
;--V CPT FILE (PROCEDURES)
W !!,"Screening the V CPT file (PROCEDURES)",!
S I="" F S I=$O(^AUPNVCPT("B",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVCPT("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVCPT(""B"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""B"","_I_",",IEN_")"
;--VISIT FILE
W !!,"Screening the VISIT file",!
S I="" F S I=$O(^AUPNVSIT("B",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVSIT("B",I,IEN)) W:IEN#10000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVSIT(""B"",I,IEN)" S VSTCNT=VSTCNT+1 I VSTCNT#1000=2 D MON^PXQUTL3
..I '$D(^AUPNVSIT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""B"","_I_",",IEN_")"
Q
;
TT ;--QUERY FOR CORRECT ENTRY
S DIR("A")="Should I fix this one by removing the reference ??"
S DIR("B")="NO"
S DIR(0)="YAO" D ^DIR
I Y=1 D
.K @ARRAY
I Y="^" Q
K DIR
Q
KILL ;--AUTOMATIC
;W !,"KILL "_ARRAY
K @ARRAY
Q
EXIT K DIR,DA,DIK
Q
Q ;---PROMPT FOR WHICH X-REF
I AUTO="F",AUTOO="F" D AA,AAH,AD,ADEL,AET,AHL,B,C,VID Q
S DIR(0)="SOM^AA:AA X-REF;AAH:AAH X-REF;AD:AD X-REF;ADEL:ADEL X-REF;AET:AET X-REF;AHL:AHL X-REF;B:B X-REF;C:C X-REF;VID:VID X-REF;ALL:ALL X-REFERENCES"
S DIR("A")="Select a VISIT Cross-reference: "
S DIR("B")="B"
D ^DIR
I Y="AA" D AA G Q
I Y="AAH" D AAH G Q
I Y="AD" D AD G Q
I Y="ADEL" D ADEL G Q
I Y="AET" D AET G Q
I Y="AHL" D AHL G Q
I Y="B" D B G Q
I Y="C" D C G Q
I Y="VID" D VID G Q
I Y="ALL" D
.D AA I Y="^" Q
.D AAH I Y="^" Q
.D AD I Y="^" Q
.D ADEL I Y="^" Q
.D AET I Y="^" Q
.D AHL I Y="^" Q
.D B I Y="^" Q
.D C I Y="^" Q
.D VID Q
K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXQUTL3A 8558 printed Jan 18, 2025@03:31:19 Page 2
PXQUTL3A ;ISL/JVS CLEAN OUT BAD XREF #2 ;4/16/97 14:30
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**29,199**;Aug 12, 1996;Build 51
+2 ;
+3 ;
+4 QUIT
+5 ;
V ;--------------VISIT FILE---------------------------------
+1 WRITE !!,"Checking the VISIT FILE #9000010 (VISITS)",!
+2 SET VSTCNT=0
+3 IF Y="^"
QUIT
+4 DO Q
+5 QUIT
AA ;-----------------AA-LEVEL 3------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('AA',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""AA"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("AA",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+5 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVSIT("AA",I,IEN,IENN))
if IENN#1000=22
WRITE "."
if IENN=""
QUIT
Begin DoDot:3
+6 SET ARRAY="^AUPNVSIT(""AA"",I,IEN,IENN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+7 IF '$DATA(^AUPNVSIT(IENN))
WRITE !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AA"","_I_",",IEN_","_IENN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:3
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+8 ;
+9 QUIT
AD ;-----------------AD-LEVEL 2------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('AD',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""AD"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("AD",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("AD",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVSIT(""AD"",I,IEN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+6 IF '$DATA(^AUPNVSIT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""AD"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+7 ;
+8 QUIT
ADEL ;-----------------ADEL-LEVEL 2------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('ADEL',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""ADEL"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("ADEL",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("ADEL",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVSIT(""ADEL"",I,IEN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+6 IF '$DATA(^AUPNVSIT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""ADEL"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+7 ;
+8 QUIT
AET ;-----------------AET-LEVEL 5------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('AET',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""AET"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("AET",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("AET",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+5 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVSIT("AET",I,IEN,IENN))
if IENN=""
QUIT
Begin DoDot:3
+6 SET IENNN=""
FOR
SET IENNN=$ORDER(^AUPNVSIT("AET",I,IEN,IENN,IENNN))
if IENNN=""
QUIT
Begin DoDot:4
+7 SET IENNNN=""
FOR
SET IENNNN=$ORDER(^AUPNVSIT("AET",I,IEN,IENN,IENNN,IENNNN))
if IENNNN#1000=22
WRITE "."
if IENNNN=""
QUIT
Begin DoDot:5
+8 SET ARRAY="^AUPNVSIT(""AET"",I,IEN,IENN,IENNN,IENNNN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+9 IF '$DATA(^AUPNVSIT(IENNNN))
WRITE !,"Entry "_IENNNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""AET"","_I_",",IEN_","_IENN_","_IENNN_","_IENNNN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+10 ;
+11 QUIT
AHL ;-----------------AHL-LEVEL 3------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('AHL',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""AHL"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("AHL",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("AHL",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+5 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVSIT("AHL",I,IEN,IENN))
if IENN#1000=22
WRITE "."
if IENN=""
QUIT
Begin DoDot:3
+6 SET ARRAY="^AUPNVSIT(""AHL"",I,IEN,IENN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+7 IF '$DATA(^AUPNVSIT(IENN))
WRITE !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AHL"","_I_",",IEN_","_IENN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:3
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+8 ;
+9 QUIT
B ;-----------------B-LEVEL 2------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('B',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""B"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("B",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("B",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVSIT(""B"",I,IEN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+6 IF '$DATA(^AUPNVSIT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""B"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+7 ;
+8 QUIT
C ;-----------------C-LEVEL 2------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('C',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""C"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("C",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("C",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVSIT(""C"",I,IEN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+6 IF '$DATA(^AUPNVSIT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""C"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+7 ;
+8 QUIT
VID ;-----------------VID-LEVEL 2------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('VID',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""VID"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("VID",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("VID",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVSIT(""VID"",I,IEN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+6 IF '$DATA(^AUPNVSIT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""VID"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+7 ;
+8 QUIT
AAH ;-----------------AAH-LEVEL 3------------------------------
+1 SET VSTXCNT=0
SET XREF="^AUPNVSIT('AAH',"
+2 WRITE !!,"Checking the ^AUPNVSIT(""AAH"") X-REF",!
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("AAH",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("AAH",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+5 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVSIT("AAH",I,IEN,IENN))
if IENN#1000=22
WRITE "."
if IENN=""
QUIT
Begin DoDot:3
+6 SET ARRAY="^AUPNVSIT(""AAH"",I,IEN,IENN)"
SET VSTCNT=VSTCNT+1
SET VSTXCNT=VSTXCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+7 IF '$DATA(^AUPNVSIT(IENN))
WRITE !,"Entry "_IENN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AAH"","_I_",",IEN_","_IENN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:3
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+8 QUIT
+9 ;
+10 ;-------------------------------------------------------
S ;++--SCREEN FOR POSSIBLE BROKEN X REFERENCES
+1 ;--V PROVIDER FILE
+2 SET (VSTCNT,CPTCNT,PRVCNT,POVCNT)=0
+3 WRITE !!,"Screening the V PROVIDER file",!
+4 SET I=""
FOR
SET I=$ORDER(^AUPNVPRV("B",I))
if I=""
QUIT
Begin DoDot:1
+5 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPRV("B",I,IEN))
if IEN#10000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+6 SET ARRAY="^AUPNVPRV(""B"",I,IEN)"
SET PRVCNT=PRVCNT+1
IF PRVCNT#1000=2
DO MON^PXQUTL3
+7 IF '$DATA(^AUPNVPRV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""B"","_I_",",IEN_")"
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+8 ;
+9 ;--V POV FILE (DIAGNOSIS)
+10 WRITE !!,"Screening the V POV file (DIAGNOSIS)",!
+11 SET I=""
FOR
SET I=$ORDER(^AUPNVPOV("B",I))
if I=""
QUIT
Begin DoDot:1
+12 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPOV("B",I,IEN))
if IEN#10000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+13 SET ARRAY="^AUPNVPOV(""B"",I,IEN)"
SET POVCNT=POVCNT+1
IF POVCNT#1000=2
DO MON^PXQUTL3
+14 IF '$DATA(^AUPNVPOV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""B"","_I_",",IEN_")"
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+15 ;--V CPT FILE (PROCEDURES)
+16 WRITE !!,"Screening the V CPT file (PROCEDURES)",!
+17 SET I=""
FOR
SET I=$ORDER(^AUPNVCPT("B",I))
if I=""
QUIT
Begin DoDot:1
+18 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVCPT("B",I,IEN))
if IEN#10000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+19 SET ARRAY="^AUPNVCPT(""B"",I,IEN)"
SET CPTCNT=CPTCNT+1
IF CPTCNT#1000=2
DO MON^PXQUTL3
+20 IF '$DATA(^AUPNVCPT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""B"","_I_",",IEN_")"
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+21 ;--VISIT FILE
+22 WRITE !!,"Screening the VISIT file",!
+23 SET I=""
FOR
SET I=$ORDER(^AUPNVSIT("B",I))
if I=""
QUIT
Begin DoDot:1
+24 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSIT("B",I,IEN))
if IEN#10000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+25 SET ARRAY="^AUPNVSIT(""B"",I,IEN)"
SET VSTCNT=VSTCNT+1
IF VSTCNT#1000=2
DO MON^PXQUTL3
+26 IF '$DATA(^AUPNVSIT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSIT(""B"","_I_",",IEN_")"
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+27 QUIT
+28 ;
TT ;--QUERY FOR CORRECT ENTRY
+1 SET DIR("A")="Should I fix this one by removing the reference ??"
+2 SET DIR("B")="NO"
+3 SET DIR(0)="YAO"
DO ^DIR
+4 IF Y=1
Begin DoDot:1
+5 KILL @ARRAY
End DoDot:1
+6 IF Y="^"
QUIT
+7 KILL DIR
+8 QUIT
KILL ;--AUTOMATIC
+1 ;W !,"KILL "_ARRAY
+2 KILL @ARRAY
+3 QUIT
EXIT KILL DIR,DA,DIK
+1 QUIT
Q ;---PROMPT FOR WHICH X-REF
+1 IF AUTO="F"
IF AUTOO="F"
DO AA
DO AAH
DO AD
DO ADEL
DO AET
DO AHL
DO B
DO C
DO VID
QUIT
+2 SET DIR(0)="SOM^AA:AA X-REF;AAH:AAH X-REF;AD:AD X-REF;ADEL:ADEL X-REF;AET:AET X-REF;AHL:AHL X-REF;B:B X-REF;C:C X-REF;VID:VID X-REF;ALL:ALL X-REFERENCES"
+3 SET DIR("A")="Select a VISIT Cross-reference: "
+4 SET DIR("B")="B"
+5 DO ^DIR
+6 IF Y="AA"
DO AA
GOTO Q
+7 IF Y="AAH"
DO AAH
GOTO Q
+8 IF Y="AD"
DO AD
GOTO Q
+9 IF Y="ADEL"
DO ADEL
GOTO Q
+10 IF Y="AET"
DO AET
GOTO Q
+11 IF Y="AHL"
DO AHL
GOTO Q
+12 IF Y="B"
DO B
GOTO Q
+13 IF Y="C"
DO C
GOTO Q
+14 IF Y="VID"
DO VID
GOTO Q
+15 IF Y="ALL"
Begin DoDot:1
+16 DO AA
IF Y="^"
QUIT
+17 DO AAH
IF Y="^"
QUIT
+18 DO AD
IF Y="^"
QUIT
+19 DO ADEL
IF Y="^"
QUIT
+20 DO AET
IF Y="^"
QUIT
+21 DO AHL
IF Y="^"
QUIT
+22 DO B
IF Y="^"
QUIT
+23 DO C
IF Y="^"
QUIT
+24 DO VID
QUIT
End DoDot:1
+25 KILL DIR
+26 QUIT
