- 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 Jan 18, 2025@03:31:18 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