PXQUTL3B ;ISL/JVS CLEAN OUT BAD XREF #3 ;6/9/97 09:05
;;1.0;PCE PATIENT CARE ENCOUNTER;**29,35,100**;Aug 12, 1996
;
Q
O ;---OTHER V FILES
;
N IMMCNT,SKCNT,XAMCNT,TRTCNT,PEDCNT,HFCNT
D I I Y="^" Q
D S I Y="^" Q
D X I Y="^" Q
D T^PXQUTL3C I Y="^" Q
D P^PXQUTL3C I Y="^" Q
D H^PXQUTL3C I Y="^" Q
Q
;
;
I W !!,"Checking the V IMMUNIZATION FILE #9000010.11 ",!
S IMMCNT=0
I Y="^" Q
S I="" F S I=$O(^AUPNVIMM("B",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVIMM("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVIMM(""B"",I,IEN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
..I '$D(^AUPNVIMM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
;-----AD
S I="" F S I=$O(^AUPNVIMM("AD",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVIMM("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVIMM(""AD"",I,IEN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
..I '$D(^AUPNVIMM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
;-----C
S I="" F S I=$O(^AUPNVIMM("C",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVIMM("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVIMM(""C"",I,IEN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
..I '$D(^AUPNVIMM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
;
;-----AA
S I="" F S I=$O(^AUPNVIMM("AA",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVIMM("AA",I,IEN)) Q:IEN="" D Q:Y="^"
..S IENN="" F S IENN=$O(^AUPNVIMM("AA",I,IEN,IENN)) Q:IENN="" D Q:Y="^"
...S IENNN="" F S IENNN=$O(^AUPNVIMM("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D Q:Y="^"
....S ARRAY="^AUPNVIMM(""AA"",I,IEN,IENN,IENNN)" S IMMCNT=IMMCNT+1 I IMMCNT#1000=2 D MON
....I '$D(^AUPNVIMM(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
Q
;
;
;
S W !!,"Checking the V SKIN TEST FILE #9000010.12 ",!
S SKCNT=0
I Y="^" Q
S I="" F S I=$O(^AUPNVSK("B",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVSK("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVSK(""B"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVSK("AD",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVSK("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVSK(""AD"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVSK("AE",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVSK("AE",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVSK(""AE"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AE"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVSK("C",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVSK("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVSK(""C"",I,IEN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
..I '$D(^AUPNVSK(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVSK("AA",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVSK("AA",I,IEN)) Q:IEN="" D Q:Y="^"
..S IENN="" F S IENN=$O(^AUPNVSK("AA",I,IEN,IENN)) Q:IENN="" D Q:Y="^"
...S IENNN="" F S IENNN=$O(^AUPNVSK("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D Q:Y="^"
....S ARRAY="^AUPNVSK(""AA"",I,IEN,IENN,IENNN)" S SKCNT=SKCNT+1 I SKCNT#1000=2 D MON
....I '$D(^AUPNVSK(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
Q
;
X W !!,"Checking the V EXAM FILE #9000010.13 ",!
S XAMCNT=0
I Y="^" Q
S I="" F S I=$O(^AUPNVXAM("B",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVXAM("B",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVXAM(""B"",I,IEN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
..I '$D(^AUPNVXAM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""B"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVXAM("AD",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVXAM("AD",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVXAM(""AD"",I,IEN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
..I '$D(^AUPNVXAM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""AD"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVXAM("C",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVXAM("C",I,IEN)) W:IEN#1000=22 "." Q:IEN="" D Q:Y="^"
..S ARRAY="^AUPNVXAM(""C"",I,IEN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
..I '$D(^AUPNVXAM(IEN)) W !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""C"","_I_",",IEN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
S I="" F S I=$O(^AUPNVXAM("AA",I)) Q:I="" D Q:Y="^"
. S IEN="" F S IEN=$O(^AUPNVXAM("AA",I,IEN)) Q:IEN="" D Q:Y="^"
..S IENN="" F S IENN=$O(^AUPNVXAM("AA",I,IEN,IENN)) Q:IENN="" D Q:Y="^"
...S IENNN="" F S IENNN=$O(^AUPNVXAM("AA",I,IEN,IENN,IENNN)) W:IENNN#1000=22 "." Q:IENNN="" D Q:Y="^"
....S ARRAY="^AUPNVXAM(""AA"",I,IEN,IENN,IENNN)" S XAMCNT=XAMCNT+1 I XAMCNT#1000=2 D MON
....I '$D(^AUPNVXAM(IENNN)) W !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""AA"","_I_",",IEN_","_IENN_","_IENNN_")" D @$S(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
Q
;
MON ;--MONITOR SITUATION
D NOW^%DTC S NOW=% S:'$G(PAST) PAST=% I $G(PAST) D S:'$G(PAST) PAST=%
.I ($P(NOW,".",2)-$P(PAST,".",2))>60 D
..D CAL K PAST
Q
CAL ;--CALCULATE TIME LEFT
N IMMT,SKT,XAMT,TRTT,PEDT,HFT
S:'$G(IMMCNT) IMMCNT=1 S:'$G(SKCNT) SKCNT=1
S:'$G(XAMCNT) XAMCNT=1 S:'$G(TRTCNT) TRTCNT=1
S:'$G(PEDCNT) PEDCNT=1 S:'$G(HFCNT) HFCNT=1
;
S IMMT=$P($G(^AUPNVIMM(0)),"^",4)*4 S:IMMT'>0 IMMT=1 S IMMP=(($G(IMMCNT)/IMMT)*100)
S SKT=$P($G(^AUPNVSK(0)),"^",4)*5 S:SKT'>0 SKT=1 S SKP=(($G(SKCNT)/SKT)*100)
S XAMT=$P($G(^AUPNVXAM(0)),"^",4)*4 S:XAMT'>0 XAMT=1 S XAMP=(($G(XAMCNT)/XAMT)*100)
S TRTT=$P($G(^AUPNVTRT(0)),"^",4)*4 S:TRTT'>0 TRTT=1 S TRTP=(($G(TRTCNT)/TRTT)*100)
S PEDT=$P($G(^AUPNVPED(0)),"^",4)*4 S:PEDT'>0 PEDT=1 S PEDP=(($G(PEDCNT)/PEDT)*100)
S HFT=$P($G(^AUPNVHF(0)),"^",4)*4 S:HFT'>0 HFT=1 S HFP=(($G(HFCNT)/HFT)*100)
;
I IMMCNT=1 S IMMCNT=0,IMMP=0
I SKCNT=1 S SKCNT=0,SKP=0
I XAMCNT=1 S XAMCNT=0,XAMP=0
I TRTCNT=1 S TRTCNT=0,TRTP=0
I PEDCNT=1 S PEDCNT=0,PEDP=0
I HFCNT=1 S HFCNT=0,HFP=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 IMMUNIZATION",?20,IMMT,?35,IMMCNT,?50,$E(IMMP,1,5)_"%"
W !,"V SKIN TEST",?20,SKT,?35,SKCNT,?50,$E(SKP,1,5)_"%"
W !,"V EXAM",?20,XAMT,?35,XAMCNT,?50,$E(XAMP,1,5)_"%"
W !,"V TREATMENT",?20,TRTT,?35,TRTCNT,?50,$E(TRTP,1,5)_"%"
W !,"V PATIENT ED",?20,PEDT,?35,PEDCNT,?50,$E(PEDP,1,5)_"%"
W !,"V HEALTH FACTOR",?20,HFT,?35,HFCNT,?50,$E(HFP,1,5)_"%"
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
PRMPT ;---PROMPT FOR PROMPTING
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXQUTL3B 8005 printed Mar 13, 2025@21:35:03 Page 2
PXQUTL3B ;ISL/JVS CLEAN OUT BAD XREF #3 ;6/9/97 09:05
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**29,35,100**;Aug 12, 1996
+2 ;
+3 QUIT
O ;---OTHER V FILES
+1 ;
+2 NEW IMMCNT,SKCNT,XAMCNT,TRTCNT,PEDCNT,HFCNT
+3 DO I
IF Y="^"
QUIT
+4 DO S
IF Y="^"
QUIT
+5 DO X
IF Y="^"
QUIT
+6 DO T^PXQUTL3C
IF Y="^"
QUIT
+7 DO P^PXQUTL3C
IF Y="^"
QUIT
+8 DO H^PXQUTL3C
IF Y="^"
QUIT
+9 QUIT
+10 ;
+11 ;
I WRITE !!,"Checking the V IMMUNIZATION FILE #9000010.11 ",!
+1 SET IMMCNT=0
+2 IF Y="^"
QUIT
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVIMM("B",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVIMM("B",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVIMM(""B"",I,IEN)"
SET IMMCNT=IMMCNT+1
IF IMMCNT#1000=2
DO MON
+6 IF '$DATA(^AUPNVIMM(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""B"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+7 ;
+8 ;-----AD
+9 SET I=""
FOR
SET I=$ORDER(^AUPNVIMM("AD",I))
if I=""
QUIT
Begin DoDot:1
+10 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVIMM("AD",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+11 SET ARRAY="^AUPNVIMM(""AD"",I,IEN)"
SET IMMCNT=IMMCNT+1
IF IMMCNT#1000=2
DO MON
+12 IF '$DATA(^AUPNVIMM(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""AD"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+13 ;
+14 ;-----C
+15 SET I=""
FOR
SET I=$ORDER(^AUPNVIMM("C",I))
if I=""
QUIT
Begin DoDot:1
+16 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVIMM("C",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+17 SET ARRAY="^AUPNVIMM(""C"",I,IEN)"
SET IMMCNT=IMMCNT+1
IF IMMCNT#1000=2
DO MON
+18 IF '$DATA(^AUPNVIMM(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""C"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+19 ;
+20 ;-----AA
+21 SET I=""
FOR
SET I=$ORDER(^AUPNVIMM("AA",I))
if I=""
QUIT
Begin DoDot:1
+22 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVIMM("AA",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+23 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVIMM("AA",I,IEN,IENN))
if IENN=""
QUIT
Begin DoDot:3
+24 SET IENNN=""
FOR
SET IENNN=$ORDER(^AUPNVIMM("AA",I,IEN,IENN,IENNN))
if IENNN#1000=22
WRITE "."
if IENNN=""
QUIT
Begin DoDot:4
+25 SET ARRAY="^AUPNVIMM(""AA"",I,IEN,IENN,IENNN)"
SET IMMCNT=IMMCNT+1
IF IMMCNT#1000=2
DO MON
+26 IF '$DATA(^AUPNVIMM(IENNN))
WRITE !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVIMM(""AA"","_I_",",IEN_","_IENN_","_IENNN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:4
if Y="^"
QUIT
End DoDot:3
if Y="^"
QUIT
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+27 QUIT
+28 ;
+29 ;
+30 ;
S WRITE !!,"Checking the V SKIN TEST FILE #9000010.12 ",!
+1 SET SKCNT=0
+2 IF Y="^"
QUIT
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVSK("B",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSK("B",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVSK(""B"",I,IEN)"
SET SKCNT=SKCNT+1
IF SKCNT#1000=2
DO MON
+6 IF '$DATA(^AUPNVSK(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""B"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+7 SET I=""
FOR
SET I=$ORDER(^AUPNVSK("AD",I))
if I=""
QUIT
Begin DoDot:1
+8 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSK("AD",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+9 SET ARRAY="^AUPNVSK(""AD"",I,IEN)"
SET SKCNT=SKCNT+1
IF SKCNT#1000=2
DO MON
+10 IF '$DATA(^AUPNVSK(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AD"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+11 SET I=""
FOR
SET I=$ORDER(^AUPNVSK("AE",I))
if I=""
QUIT
Begin DoDot:1
+12 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSK("AE",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+13 SET ARRAY="^AUPNVSK(""AE"",I,IEN)"
SET SKCNT=SKCNT+1
IF SKCNT#1000=2
DO MON
+14 IF '$DATA(^AUPNVSK(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AE"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+15 SET I=""
FOR
SET I=$ORDER(^AUPNVSK("C",I))
if I=""
QUIT
Begin DoDot:1
+16 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSK("C",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+17 SET ARRAY="^AUPNVSK(""C"",I,IEN)"
SET SKCNT=SKCNT+1
IF SKCNT#1000=2
DO MON
+18 IF '$DATA(^AUPNVSK(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""C"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+19 SET I=""
FOR
SET I=$ORDER(^AUPNVSK("AA",I))
if I=""
QUIT
Begin DoDot:1
+20 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVSK("AA",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+21 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVSK("AA",I,IEN,IENN))
if IENN=""
QUIT
Begin DoDot:3
+22 SET IENNN=""
FOR
SET IENNN=$ORDER(^AUPNVSK("AA",I,IEN,IENN,IENNN))
if IENNN#1000=22
WRITE "."
if IENNN=""
QUIT
Begin DoDot:4
+23 SET ARRAY="^AUPNVSK(""AA"",I,IEN,IENN,IENNN)"
SET SKCNT=SKCNT+1
IF SKCNT#1000=2
DO MON
+24 IF '$DATA(^AUPNVSK(IENNN))
WRITE !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVSK(""AA"","_I_",",IEN_","_IENN_","_IENNN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:4
if Y="^"
QUIT
End DoDot:3
if Y="^"
QUIT
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+25 QUIT
+26 ;
X WRITE !!,"Checking the V EXAM FILE #9000010.13 ",!
+1 SET XAMCNT=0
+2 IF Y="^"
QUIT
+3 SET I=""
FOR
SET I=$ORDER(^AUPNVXAM("B",I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVXAM("B",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+5 SET ARRAY="^AUPNVXAM(""B"",I,IEN)"
SET XAMCNT=XAMCNT+1
IF XAMCNT#1000=2
DO MON
+6 IF '$DATA(^AUPNVXAM(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""B"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+7 SET I=""
FOR
SET I=$ORDER(^AUPNVXAM("AD",I))
if I=""
QUIT
Begin DoDot:1
+8 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVXAM("AD",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+9 SET ARRAY="^AUPNVXAM(""AD"",I,IEN)"
SET XAMCNT=XAMCNT+1
IF XAMCNT#1000=2
DO MON
+10 IF '$DATA(^AUPNVXAM(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""AD"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+11 SET I=""
FOR
SET I=$ORDER(^AUPNVXAM("C",I))
if I=""
QUIT
Begin DoDot:1
+12 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVXAM("C",I,IEN))
if IEN#1000=22
WRITE "."
if IEN=""
QUIT
Begin DoDot:2
+13 SET ARRAY="^AUPNVXAM(""C"",I,IEN)"
SET XAMCNT=XAMCNT+1
IF XAMCNT#1000=2
DO MON
+14 IF '$DATA(^AUPNVXAM(IEN))
WRITE !,"Entry "_IEN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""C"","_I_",",IEN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+15 SET I=""
FOR
SET I=$ORDER(^AUPNVXAM("AA",I))
if I=""
QUIT
Begin DoDot:1
+16 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVXAM("AA",I,IEN))
if IEN=""
QUIT
Begin DoDot:2
+17 SET IENN=""
FOR
SET IENN=$ORDER(^AUPNVXAM("AA",I,IEN,IENN))
if IENN=""
QUIT
Begin DoDot:3
+18 SET IENNN=""
FOR
SET IENNN=$ORDER(^AUPNVXAM("AA",I,IEN,IENN,IENNN))
if IENNN#1000=22
WRITE "."
if IENNN=""
QUIT
Begin DoDot:4
+19 SET ARRAY="^AUPNVXAM(""AA"",I,IEN,IENN,IENNN)"
SET XAMCNT=XAMCNT+1
IF XAMCNT#1000=2
DO MON
+20 IF '$DATA(^AUPNVXAM(IENNN))
WRITE !,"Entry "_IENNN," IS NOT THERE! BAD REFERENCE IS ^AUPNVXAM(""AA"","_I_",",IEN_","_IENN_","_IENNN_")"
DO @$SELECT(AUTO="F":"KILL",AUTO'="F":"TT",1:"")
End DoDot:4
if Y="^"
QUIT
End DoDot:3
if Y="^"
QUIT
End DoDot:2
if Y="^"
QUIT
End DoDot:1
if Y="^"
QUIT
+21 QUIT
+22 ;
MON ;--MONITOR SITUATION
+1 DO NOW^%DTC
SET NOW=%
if '$GET(PAST)
SET PAST=%
IF $GET(PAST)
Begin DoDot:1
+2 IF ($PIECE(NOW,".",2)-$PIECE(PAST,".",2))>60
Begin DoDot:2
+3 DO CAL
KILL PAST
End DoDot:2
End DoDot:1
if '$GET(PAST)
SET PAST=%
+4 QUIT
CAL ;--CALCULATE TIME LEFT
+1 NEW IMMT,SKT,XAMT,TRTT,PEDT,HFT
+2 if '$GET(IMMCNT)
SET IMMCNT=1
if '$GET(SKCNT)
SET SKCNT=1
+3 if '$GET(XAMCNT)
SET XAMCNT=1
if '$GET(TRTCNT)
SET TRTCNT=1
+4 if '$GET(PEDCNT)
SET PEDCNT=1
if '$GET(HFCNT)
SET HFCNT=1
+5 ;
+6 SET IMMT=$PIECE($GET(^AUPNVIMM(0)),"^",4)*4
if IMMT'>0
SET IMMT=1
SET IMMP=(($GET(IMMCNT)/IMMT)*100)
+7 SET SKT=$PIECE($GET(^AUPNVSK(0)),"^",4)*5
if SKT'>0
SET SKT=1
SET SKP=(($GET(SKCNT)/SKT)*100)
+8 SET XAMT=$PIECE($GET(^AUPNVXAM(0)),"^",4)*4
if XAMT'>0
SET XAMT=1
SET XAMP=(($GET(XAMCNT)/XAMT)*100)
+9 SET TRTT=$PIECE($GET(^AUPNVTRT(0)),"^",4)*4
if TRTT'>0
SET TRTT=1
SET TRTP=(($GET(TRTCNT)/TRTT)*100)
+10 SET PEDT=$PIECE($GET(^AUPNVPED(0)),"^",4)*4
if PEDT'>0
SET PEDT=1
SET PEDP=(($GET(PEDCNT)/PEDT)*100)
+11 SET HFT=$PIECE($GET(^AUPNVHF(0)),"^",4)*4
if HFT'>0
SET HFT=1
SET HFP=(($GET(HFCNT)/HFT)*100)
+12 ;
+13 IF IMMCNT=1
SET IMMCNT=0
SET IMMP=0
+14 IF SKCNT=1
SET SKCNT=0
SET SKP=0
+15 IF XAMCNT=1
SET XAMCNT=0
SET XAMP=0
+16 IF TRTCNT=1
SET TRTCNT=0
SET TRTP=0
+17 IF PEDCNT=1
SET PEDCNT=0
SET PEDP=0
+18 IF HFCNT=1
SET HFCNT=0
SET HFP=0
+19 WRITE !!," - - M O N I T O R AT 1 MINUTE- -"
NEW Y,%
DO YX^%DTC
WRITE " "_Y
+20 WRITE !,"FILE",?20,"TOTAL",?35,"#FINISHED",?50,"%COMPLETED"
+21 WRITE !,"V IMMUNIZATION",?20,IMMT,?35,IMMCNT,?50,$EXTRACT(IMMP,1,5)_"%"
+22 WRITE !,"V SKIN TEST",?20,SKT,?35,SKCNT,?50,$EXTRACT(SKP,1,5)_"%"
+23 WRITE !,"V EXAM",?20,XAMT,?35,XAMCNT,?50,$EXTRACT(XAMP,1,5)_"%"
+24 WRITE !,"V TREATMENT",?20,TRTT,?35,TRTCNT,?50,$EXTRACT(TRTP,1,5)_"%"
+25 WRITE !,"V PATIENT ED",?20,PEDT,?35,PEDCNT,?50,$EXTRACT(PEDP,1,5)_"%"
+26 WRITE !,"V HEALTH FACTOR",?20,HFT,?35,HFCNT,?50,$EXTRACT(HFP,1,5)_"%"
+27 QUIT
+28 ;
+29 ;
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
PRMPT ;---PROMPT FOR PROMPTING
+1 SET DIR("A")="Eliminate Prompting for Confirmation? "
+2 SET DIR("B")="NO"
+3 SET DIR(0)="YAO"
+4 DO ^DIR
+5 IF Y=1
SET AUTO="F"
+6 KILL DIR
+7 QUIT
