PXQUTL3 ;ISL/JVS CLEAN OUT BAD CROSSREFERENCES ;4/16/97 14:30
;;1.0;PCE PATIENT CARE ENCOUNTER;**29,131**;Aug 12, 1996
;
T ;
;
W !!!," NOTES CONCERNING THIS OPTION"
W !
W !," These options will check for broken cross-references in all of"
W !," the PCE visit files. It is interactive."
W !," 'S' will go through ONLY the 'B' X-REF of each file looking for problems."
W !," To EXIT the program, you can enter an '^' at any prompt."
W !," At about 1 minute intervals a message will come up telling you"
W !," how much work has already been done."
W !
S Y=""
S DIR(0)="S^S:Screen of 4 'MAIN' files;P:Provider V PROVIDER FILE;"
S DIR(0)=DIR(0)_"D:Diagnosis V POV FILE;C:CPT V CPT FILE;"
S DIR(0)=DIR(0)_"V:Visit VISIT FILE;O:Other 6 V Files;"
S DIR(0)=DIR(0)_"R:Repair 4 'MAIN' V Files without prompting (automatic);"
S DIR(0)=DIR(0)_"F:Fix ALL files without prompting (automatic)"
S DIR("A")="Which file do you need to fix "
S DIR("B")="P"
D ^DIR
N X,IEN,IENN,IENNN,I,ARRAY,PAST,NOW,%,PRVCNT,PRVP,POVCNT,POVP
N CPTCNT,CNTP,VSTCNT,VSTP,AUTO,XREF,VSTXCNT,AUTOO
S (AUTO,AUTOO)="",XREF="NONE",VSTXCNT=0
I Y="P" D PRMPT,P G T
I Y="D" D PRMPT,D G T
I Y="C" D PRMPT,C G T
I Y="O" D INF,PRMPT,O^PXQUTL3B G T
I Y="V" D PRMPT,V^PXQUTL3A G T
I Y="R" D PRMPT S:AUTO="F" AUTOO="F" D P,D,C,V^PXQUTL3A G T
I Y="S" D S^PXQUTL3A G T
I Y="F" S (AUTO,AUTOO)="F" D P,D,C,V^PXQUTL3A,O^PXQUTL3B G T
I Y="^" G EXIT
Q
;
;
;
P ;---CHECK FOR BROKEN CROSSREFERENCES
S PRVCNT=0
I Y="^" Q
W !,"Checking the V PROVIDER FILE #9000010.06",!
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#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVPRV(""B"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON
..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVPRV("AD",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVPRV("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVPRV(""AD"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON
..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVPRV("C",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVPRV("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVPRV(""C"",I,IEN)" S PRVCNT=PRVCNT+1 I PRVCNT#1000=2 D MON
..I '$D(^AUPNVPRV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
Q
;
;
;
;
D W !!,"Checking the V POV FILE #9000010.07 (PROCEDURES)",!
S POVCNT=0
I Y="^" Q
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#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVPOV(""B"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVPOV("AD",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVPOV("AD",I,IEN)) Q:IEN="" D
..S ARRAY="^AUPNVPOV(""AD"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVPOV("C",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVPOV("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVPOV(""C"",I,IEN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
..I '$D(^AUPNVPOV(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVPOV("AA",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVPOV("AA",I,IEN)) Q:IEN="" D
..S IENN="" F S IENN=$O(^AUPNVPOV("AA",I,IEN,IENN)) W:IENN#1000=22 "." Q:IENN="" D
...S ARRAY="^AUPNVPOV(""AA"",I,IEN,IENN)" S POVCNT=POVCNT+1 I POVCNT#1000=2 D MON
...I '$D(^AUPNVPOV(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
;
;
C W !!,"Checking the V CPT FILE #9000010.18 (PROCEDURES)",!
S CPTCNT=0
I Y="^" Q
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#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVCPT(""B"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVCPT("AD",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVCPT("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVCPT(""AD"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVCPT("C",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVCPT("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D
..S ARRAY="^AUPNVCPT(""C"",I,IEN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
..I '$D(^AUPNVCPT(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVCPT("AA",I)) Q:I="" D G:Y="^" EXIT
. S IEN="" F S IEN=$O(^AUPNVCPT("AA",I,IEN)) Q:IEN="" D
..S IENN="" F S IENN=$O(^AUPNVCPT("AA",I,IEN,IENN)) Q:IENN="" D
...S IENNN="" F S IENNN=$O(^AUPNVCPT("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D
....S ARRAY="^AUPNVCPT(""AA"",I,IEN,IENN,IENNN)" S CPTCNT=CPTCNT+1 I CPTCNT#1000=2 D MON
....I '$D(^AUPNVCPT(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
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
Q
KILL ;--AUTOMATIC
;W !,"KILL "_ARRAY
K @ARRAY
Q
EXIT K DIR,DA,DIK
Q
MON ;--MONITOR SITUATION
D NOW^%DTC S NOW=% S:'$G(PAST) PAST=% I $G(PAST) D S:'$G(PAST) PAST=%
.I $P(NOW,".",1)'=$P(PAST,".",1) K PAST Q
.I ($P(NOW,".",2)-$P(PAST,".",2))>60 D
..D CAL K PAST
Q
CAL ;--CALCULATE TIME LEFT
N PRVT,POVT,CPTT,VSTT
N CPTP,VSTX,VSTXP ;PX*1.0*131 (to satisfy ^XINDEX)
S:'$G(PRVCNT) PRVCNT=1 S:'$G(POVCNT) POVCNT=1
S:'$G(CPTCNT) CPTCNT=1 S:'$G(VSTCNT) VSTCNT=1
S PRVT=$P($G(^AUPNVPRV(0)),"^",4)*3,PRVP=(($G(PRVCNT)/PRVT)*100)
S POVT=$P($G(^AUPNVPOV(0)),"^",4)*4,POVP=(($G(POVCNT)/POVT)*100)
S CPTT=$P($G(^AUPNVCPT(0)),"^",4)*4,CPTP=(($G(CPTCNT)/CPTT)*100)
S VSTT=$P($G(^AUPNVSIT(0)),"^",4)*9,VSTP=(($G(VSTCNT)/VSTT)*100)
S VSTX=$P($G(^AUPNVSIT(0)),"^",4),VSTXP=(($G(VSTXCNT)/VSTX)*100)
I PRVCNT=1 S PRVCNT=0,PRVP=0
I POVCNT=1 S POVCNT=0,POVP=0
I CPTCNT=1 S CPTCNT=0,CPTP=0
I VSTCNT=1 S VSTCNT=0,VSTP=0
W !!," - - M O N I T O R AT 1 MINUTE- -" N Y D YX^%DTC W " "_Y
W !,"FILE",?20,"TOTAL",?35,"#FINISHED",?50,"%COMPLETED"
W !,"V PROVIDER",?20,PRVT,?35,PRVCNT,?50,$E(PRVP,1,5)_"%"
W !,"V POV",?20,POVT,?35,POVCNT,?50,$E(POVP,1,5)_"%"
W !,"V CPT",?20,CPTT,?35,CPTCNT,?50,$E(CPTP,1,5)_"%"
W !,"VISIT",?20,VSTT,?35,VSTCNT,?50,$E(VSTP,1,5)_"%"
W !,XREF,?20,VSTX,?35,VSTXCNT,?50,$E(VSTXP,1,5)_"%"
Q
PRMPT ;---PROMPT FOR PROMPTING
S DIR("?",1)="By saying YES to this prompt, you will eliminate being asked"
S DIR("?")="over and over again, 'Should I fix this one by removing the reference ??'"
S DIR("A")="Eliminate Prompting for Confirmation? "
S DIR("B")="NO"
S DIR(0)="YAO"
D ^DIR
I Y=1 S AUTO="F"
K DIR
Q
INF ;--LIST OF OTHER 6 V FILES
W !!,"The 'OTHER' 6 V-files are:"
W !,"V IMMUNIZATION file#9000010.11"
W !,"V SKIN TEST file#9000010.12"
W !,"V EXAM file#9000010.13"
W !,"V TREATMENT file#9000010.15"
W !,"V PATIENT ED file#9000010.16"
W !,"V HEALTH FACTOR file#9000010.23",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXQUTL3 8343 printed Apr 09, 2024@21:28:23 Page 2
PXQUTL3 ;ISL/JVS CLEAN OUT BAD CROSSREFERENCES ;4/16/97 14:30
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**29,131**;Aug 12, 1996
+2 ;
T ;
+1 ;
+2 WRITE !!!," NOTES CONCERNING THIS OPTION"
+3 WRITE !
+4 WRITE !," These options will check for broken cross-references in all of"
+5 WRITE !," the PCE visit files. It is interactive."
+6 WRITE !," 'S' will go through ONLY the 'B' X-REF of each file looking for problems."
+7 WRITE !," To EXIT the program, you can enter an '^' at any prompt."
+8 WRITE !," At about 1 minute intervals a message will come up telling you"
+9 WRITE !," how much work has already been done."
+10 WRITE !
+11 SET Y=""
+12 SET DIR(0)="S^S:Screen of 4 'MAIN' files;P:Provider V PROVIDER FILE;"
+13 SET DIR(0)=DIR(0)_"D:Diagnosis V POV FILE;C:CPT V CPT FILE;"
+14 SET DIR(0)=DIR(0)_"V:Visit VISIT FILE;O:Other 6 V Files;"
+15 SET DIR(0)=DIR(0)_"R:Repair 4 'MAIN' V Files without prompting (automatic);"
+16 SET DIR(0)=DIR(0)_"F:Fix ALL files without prompting (automatic)"
+17 SET DIR("A")="Which file do you need to fix "
+18 SET DIR("B")="P"
+19 DO ^DIR
+20 NEW X,IEN,IENN,IENNN,I,ARRAY,PAST,NOW,%,PRVCNT,PRVP,POVCNT,POVP
+21 NEW CPTCNT,CNTP,VSTCNT,VSTP,AUTO,XREF,VSTXCNT,AUTOO
+22 SET (AUTO,AUTOO)=""
SET XREF="NONE"
SET VSTXCNT=0
+23 IF Y="P"
DO PRMPT
DO P
GOTO T
+24 IF Y="D"
DO PRMPT
DO D
GOTO T
+25 IF Y="C"
DO PRMPT
DO C
GOTO T
+26 IF Y="O"
DO INF
DO PRMPT
DO O^PXQUTL3B
GOTO T
+27 IF Y="V"
DO PRMPT
DO V^PXQUTL3A
GOTO T
+28 IF Y="R"
DO PRMPT
if AUTO="F"
SET AUTOO="F"
DO P
DO D
DO C
DO V^PXQUTL3A
GOTO T
+29 IF Y="S"
DO S^PXQUTL3A
GOTO T
+30 IF Y="F"
SET (AUTO,AUTOO)="F"
DO P
DO D
DO C
DO V^PXQUTL3A
DO O^PXQUTL3B
GOTO T
+31 IF Y="^"
GOTO EXIT
+32 QUIT
+33 ;
+34 ;
+35 ;
P ;---CHECK FOR BROKEN CROSSREFERENCES
+1 SET PRVCNT=0
+2 IF Y="^"
QUIT
+3 WRITE !,"Checking the V PROVIDER FILE #9000010.06",!
+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#1000=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
+7 IF '$DATA(^AUPNVPRV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""B"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+8 SET I=""
FOR
SET I=$ORDER(^AUPNVPRV("AD",I))
if I=""
QUIT
Begin DoDot:1
+9 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPRV("AD",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+10 SET ARRAY="^AUPNVPRV(""AD"",I,IEN)"
SET PRVCNT=PRVCNT+1
IF PRVCNT#1000=2
DO MON
+11 IF '$DATA(^AUPNVPRV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""AD"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+12 SET I=""
FOR
SET I=$ORDER(^AUPNVPRV("C",I))
if I=""
QUIT
Begin DoDot:1
+13 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPRV("C",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+14 SET ARRAY="^AUPNVPRV(""C"",I,IEN)"
SET PRVCNT=PRVCNT+1
IF PRVCNT#1000=2
DO MON
+15 IF '$DATA(^AUPNVPRV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPRV(""C"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+16 QUIT
+17 ;
+18 ;
+19 ;
+20 ;
D WRITE !!,"Checking the V POV FILE #9000010.07 (PROCEDURES)",!
+1 SET POVCNT=0
+2 IF Y="^"
QUIT
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVPOV("B",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPOV("B",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVPOV(""B"",I,IEN)"
SET POVCNT=POVCNT+1
IF POVCNT#1000=2
DO MON
+6 IF '$DATA(^AUPNVPOV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""B"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+7 SET I=""
FOR
SET I=$ORDER(^AUPNVPOV("AD",I))
if I=""
QUIT
Begin DoDot:1
+8 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPOV("AD",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+9 SET ARRAY="^AUPNVPOV(""AD"",I,IEN)"
SET POVCNT=POVCNT+1
IF POVCNT#1000=2
DO MON
+10 IF '$DATA(^AUPNVPOV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""AD"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+11 SET I=""
FOR
SET I=$ORDER(^AUPNVPOV("C",I))
if I=""
QUIT
Begin DoDot:1
+12 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPOV("C",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+13 SET ARRAY="^AUPNVPOV(""C"",I,IEN)"
SET POVCNT=POVCNT+1
IF POVCNT#1000=2
DO MON
+14 IF '$DATA(^AUPNVPOV(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVPOV(""C"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+15 SET I=""
FOR
SET I=$ORDER(^AUPNVPOV("AA",I))
if I=""
QUIT
Begin DoDot:1
+16 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVPOV("AA",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+17 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVPOV("AA",I,IEN,IENN))
if IENN#1000=22
WRITE "."
if IENN=""
QUIT
Begin DoDot:3
+18 SET ARRAY="^AUPNVPOV(""AA"",I,IEN,IENN)"
SET POVCNT=POVCNT+1
IF POVCNT#1000=2
DO MON
+19 IF '$DATA(^AUPNVPOV(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
+20 QUIT
+21 ;
+22 ;
C WRITE !!,"Checking the V CPT FILE #9000010.18 (PROCEDURES)",!
+1 SET CPTCNT=0
+2 IF Y="^"
QUIT
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVCPT("B",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVCPT("B",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVCPT(""B"",I,IEN)"
SET CPTCNT=CPTCNT+1
IF CPTCNT#1000=2
DO MON
+6 IF '$DATA(^AUPNVCPT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""B"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+7 SET I=""
FOR
SET I=$ORDER(^AUPNVCPT("AD",I))
if I=""
QUIT
Begin DoDot:1
+8 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVCPT("AD",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+9 SET ARRAY="^AUPNVCPT(""AD"",I,IEN)"
SET CPTCNT=CPTCNT+1
IF CPTCNT#1000=2
DO MON
+10 IF '$DATA(^AUPNVCPT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""AD"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+11 SET I=""
FOR
SET I=$ORDER(^AUPNVCPT("C",I))
if I=""
QUIT
Begin DoDot:1
+12 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVCPT("C",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+13 SET ARRAY="^AUPNVCPT(""C"",I,IEN)"
SET CPTCNT=CPTCNT+1
IF CPTCNT#1000=2
DO MON
+14 IF '$DATA(^AUPNVCPT(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""C"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+15 SET I=""
FOR
SET I=$ORDER(^AUPNVCPT("AA",I))
if I=""
QUIT
Begin DoDot:1
+16 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVCPT("AA",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+17 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVCPT("AA",I,IEN,IENN))
if IENN=""
QUIT
Begin DoDot:3
+18 SET IENNN=""
FOR
SET IENNN=$ORDER(^AUPNVCPT("AA",I,IEN,IENN,IENNN))
if IENNN#1000=22
WRITE "."
if IENNN=""
QUIT
Begin DoDot:4
+19 SET ARRAY="^AUPNVCPT(""AA"",I,IEN,IENN,IENNN)"
SET CPTCNT=CPTCNT+1
IF CPTCNT#1000=2
DO MON
+20 IF '$DATA(^AUPNVCPT(IENNN))
WRITE !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVCPT(""AA"","_I_",",IEN_","_IENN_","_IENNN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
if Y="^"
GOTO EXIT
+21 QUIT
+22 ;
+23 ;
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 QUIT
KILL ;--AUTOMATIC
+1 ;W !,"KILL "_ARRAY
+2 KILL @ARRAY
+3 QUIT
EXIT KILL DIR,DA,DIK
+1 QUIT
MON ;--MONITOR SITUATION
+1 DO NOW^%DTC
SET NOW=%
if '$GET(PAST)
SET PAST=%
IF $GET(PAST)
Begin DoDot:1
+2 IF $PIECE(NOW,".",1)'=$PIECE(PAST,".",1)
KILL PAST
QUIT
+3 IF ($PIECE(NOW,".",2)-$PIECE(PAST,".",2))>60
Begin DoDot:2
+4 DO CAL
KILL PAST
End DoDot:2
End DoDot:1
if '$GET(PAST)
SET PAST=%
+5 QUIT
CAL ;--CALCULATE TIME LEFT
+1 NEW PRVT,POVT,CPTT,VSTT
+2 ;PX*1.0*131 (to satisfy ^XINDEX)
NEW CPTP,VSTX,VSTXP
+3 if '$GET(PRVCNT)
SET PRVCNT=1
if '$GET(POVCNT)
SET POVCNT=1
+4 if '$GET(CPTCNT)
SET CPTCNT=1
if '$GET(VSTCNT)
SET VSTCNT=1
+5 SET PRVT=$PIECE($GET(^AUPNVPRV(0)),"^",4)*3
SET PRVP=(($GET(PRVCNT)/PRVT)*100)
+6 SET POVT=$PIECE($GET(^AUPNVPOV(0)),"^",4)*4
SET POVP=(($GET(POVCNT)/POVT)*100)
+7 SET CPTT=$PIECE($GET(^AUPNVCPT(0)),"^",4)*4
SET CPTP=(($GET(CPTCNT)/CPTT)*100)
+8 SET VSTT=$PIECE($GET(^AUPNVSIT(0)),"^",4)*9
SET VSTP=(($GET(VSTCNT)/VSTT)*100)
+9 SET VSTX=$PIECE($GET(^AUPNVSIT(0)),"^",4)
SET VSTXP=(($GET(VSTXCNT)/VSTX)*100)
+10 IF PRVCNT=1
SET PRVCNT=0
SET PRVP=0
+11 IF POVCNT=1
SET POVCNT=0
SET POVP=0
+12 IF CPTCNT=1
SET CPTCNT=0
SET CPTP=0
+13 IF VSTCNT=1
SET VSTCNT=0
SET VSTP=0
+14 WRITE !!," - - M O N I T O R AT 1 MINUTE- -"
NEW Y
DO YX^%DTC
WRITE " "_Y
+15 WRITE !,"FILE",?20,"TOTAL",?35,"#FINISHED",?50,"%COMPLETED"
+16 WRITE !,"V PROVIDER",?20,PRVT,?35,PRVCNT,?50,$EXTRACT(PRVP,1,5)_"%"
+17 WRITE !,"V POV",?20,POVT,?35,POVCNT,?50,$EXTRACT(POVP,1,5)_"%"
+18 WRITE !,"V CPT",?20,CPTT,?35,CPTCNT,?50,$EXTRACT(CPTP,1,5)_"%"
+19 WRITE !,"VISIT",?20,VSTT,?35,VSTCNT,?50,$EXTRACT(VSTP,1,5)_"%"
+20 WRITE !,XREF,?20,VSTX,?35,VSTXCNT,?50,$EXTRACT(VSTXP,1,5)_"%"
+21 QUIT
PRMPT ;---PROMPT FOR PROMPTING
+1 SET DIR("?",1)="By saying YES to this prompt, you will eliminate being asked"
+2 SET DIR("?")="over and over again, 'Should I fix this one by removing the reference ??'"
+3 SET DIR("A")="Eliminate Prompting for Confirmation? "
+4 SET DIR("B")="NO"
+5 SET DIR(0)="YAO"
+6 DO ^DIR
+7 IF Y=1
SET AUTO="F"
+8 KILL DIR
+9 QUIT
INF ;--LIST OF OTHER 6 V FILES
+1 WRITE !!,"The 'OTHER' 6 V-files are:"
+2 WRITE !,"V IMMUNIZATION file#9000010.11"
+3 WRITE !,"V SKIN TEST file#9000010.12"
+4 WRITE !,"V EXAM file#9000010.13"
+5 WRITE !,"V TREATMENT file#9000010.15"
+6 WRITE !,"V PATIENT ED file#9000010.16"
+7 WRITE !,"V HEALTH FACTOR file#9000010.23",!
+8 QUIT
