RTFIX ;PKE/ISC-ALBANY-Cleanup 190.3 Routine; ; 4/7/93 11:45 AM ; [ 08/01/93 9:42 PM ]
;;v 2.0;Record Tracking;**12**;10/22/91
;check movement file, #190.3 for pointers, x-ref
;
EN ;entry point
L +^TMP("RTFIX","START"):300 E W !!?3,"Another RTFIX is running" Q
;
;if RTDB=0 just checks for bad nodes(debug)
I '$D(RTDB) S RTDB=1
;
;if debug was on, start over
I RTDB,$D(^TMP("RTFIX","DEBUG")) K ^TMP("RTFIX")
;if debug is on, remember
I RTDB=0 S ^TMP("RTFIX","DEBUG")=""
;
S RT=$S('$D(^TMP("RTFIX","START")):0,1:+^("START")) I RT S RT=RT-1
D DT^DICRW,NOW^%DTC S RTIME=%,RTIM=X
;purge-node if using xtmp
S X1=X,X2=5 D C^%DTC
S $P(^TMP("RTFIX",0),"^",1,2)=X_"^"_RTIM
S ^TMP("RTFIX","START")=RT_"^"_RTIME
K ^TMP("RTFIX","STOP")
;
CONT F RTCT=1:1 S RT=$O(^RTV(190.3,"B",RT)) Q:'RT DO
.I RTCT#1000=0 DO
..S $P(^TMP("RTFIX","START"),"^",1)=RT
..I '$D(^TMP("RTFIX","RATE")) S (RATE,^("RATE"))=$P($H,",",2)
..E S RATE=$P(^("RATE"),"^"),RATE=(+$P($H,",",2))-RATE ;naked ref to tmp(rtfix,rate)
..S RATE=$J((RATE/60),5,1)
..S ^("RATE")=$P($H,",",2)_"^"_RATE_"^"_RT ;naked ref to tmp(rtfix,rate)
..I $D(^TMP("RTFIX","STOP")) S RT="Zend" Q ;stop if stopjob^rtfix
..I $$S^%ZTLOAD S RT="Zend",^TMP("RTFIX","STOP")="",ZTSTOP=1 Q
..I '$D(ZTQUEUED) W "."
.;
.S RTH=0
.F S RTH=$O(^RTV(190.3,"B",RT,RTH)) Q:'RTH DO
..I '$D(^RTV(190.3,RTH,0)) DO Q
...L +^RTV(190.3,RTH)
...K:RTDB ^RTV(190.3,"B",RT,RTH) L -^RTV(190.3,RTH)
...S ^TMP("RTFIX","XREF",RTH)=RT
...Q
..I +^RTV(190.3,RTH,0)'=RT DO Q
...S RTM0=^(0) ;naked ref to rtv(190.3,rth,0)
...I 'RTM0,$D(^RT(RT,"CL")),+$P(^("CL"),"^",2)=RTH Q
...L +^RTV(190.3,RTH)
...K:RTDB ^RTV(190.3,"B",RT,RTH) L -^RTV(190.3,RTH)
...S DA=RTH,DIK="^RTV(190.3,"
...I '$D(^RT(+RTM0,0)) D:RTDB ^DIK S ^TMP("RTFIX","XMOVE",RTH)=RT Q
...I RTM0 D:RTDB IX^DIK S ^TMP("RTFIX","XINDEX",RTH)=RT
...Q
..Q
;
L -^TMP("RTFIX","START")
D NOW^%DTC I $D(^TMP("RTFIX","STOP")) S ^("STOP")=%_"^"_RTCT N ZTSTOP D KILL Q
K:RTDB ^TMP("RTFIX")
KILL D KILL^XUSCLEAN Q
;
QUE ;entry to queue with taskman from prog mode
S ZTIO="",ZTRTN="EN^RTFIX",ZTDESC="RT Check/Fix file 190.3"
D ^%ZTLOAD Q
;
JOB S ZTQUEUED="" G EN^RTFIX Q
;
DEBUG S RTDB=0 G EN^RTFIX Q
;
STOPJOB ;entry to stop job after about 1000 records if jobbed or tasked
S ^TMP("RTFIX","STOP")=""
W !?5,"The RTFIX routine will be stopping soon . . ." Q
;
RATE ;entry to see how its going
Q:'$D(^TMP("RTFIX","RATE"))
L +^TMP("RTFIX","RATE")
W !?3,"Minutes/1K records = ",$P(^TMP("RTFIX","RATE"),"^",2)
W !?3," Current Record # = ",$P(^TMP("RTFIX","RATE"),"^",3)
W !?3," Last Record # = ",$P(^RT(0),"^",3),!
L -^TMP("RTFIX","RATE") Q
;
DOC ;The routine can run from programmer mode by
;D ^RTFIX
;
;The routine can be queued through TaskMan by
;D QUE^RTFIX
;
;The routine can be run in DEBUG mode by
;D DEBUG^RTFIX
;
;The routine can be stopped at any time by
;D STOPJOB^RTFIX or TBOX option for a taskman job
;
;The routine can be restarted where it left off as
;long as the global ^TMP("RTFIX" still exists.
;
;The status of the job can be monitored by
;D RATE^RTFIX
;
;XQ XUTL $J NODES option should be suspended on cpu when this
;routine is running to prevent ^TMP from being killed
;
;^TMP is only used to store start/stop and bad movements found
;
; Can be changed to use standard use of ^xtmp global by changing
; every ^tmp to ^xtmp. Will set nodes correctly to avoid xtmp
; purge.
;
;^TMP(nodes) description action
;
;^("XREF",RTMOV)=RT means a "B" entry with xref deleted
; no zero node
;^("XMOVE"... means no record movement deleted
;^("XINDEX"... means different record xref corrected
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTFIX 3876 printed Nov 22, 2024@17:43:55 Page 2
RTFIX ;PKE/ISC-ALBANY-Cleanup 190.3 Routine; ; 4/7/93 11:45 AM ; [ 08/01/93 9:42 PM ]
+1 ;;v 2.0;Record Tracking;**12**;10/22/91
+2 ;check movement file, #190.3 for pointers, x-ref
+3 ;
EN ;entry point
+1 LOCK +^TMP("RTFIX","START"):300
IF '$TEST
WRITE !!?3,"Another RTFIX is running"
QUIT
+2 ;
+3 ;if RTDB=0 just checks for bad nodes(debug)
+4 IF '$DATA(RTDB)
SET RTDB=1
+5 ;
+6 ;if debug was on, start over
+7 IF RTDB
IF $DATA(^TMP("RTFIX","DEBUG"))
KILL ^TMP("RTFIX")
+8 ;if debug is on, remember
+9 IF RTDB=0
SET ^TMP("RTFIX","DEBUG")=""
+10 ;
+11 SET RT=$SELECT('$DATA(^TMP("RTFIX","START")):0,1:+^("START"))
IF RT
SET RT=RT-1
+12 DO DT^DICRW
DO NOW^%DTC
SET RTIME=%
SET RTIM=X
+13 ;purge-node if using xtmp
+14 SET X1=X
SET X2=5
DO C^%DTC
+15 SET $PIECE(^TMP("RTFIX",0),"^",1,2)=X_"^"_RTIM
+16 SET ^TMP("RTFIX","START")=RT_"^"_RTIME
+17 KILL ^TMP("RTFIX","STOP")
+18 ;
CONT FOR RTCT=1:1
SET RT=$ORDER(^RTV(190.3,"B",RT))
if 'RT
QUIT
Begin DoDot:1
+1 IF RTCT#1000=0
Begin DoDot:2
+2 SET $PIECE(^TMP("RTFIX","START"),"^",1)=RT
+3 IF '$DATA(^TMP("RTFIX","RATE"))
SET (RATE,^("RATE"))=$PIECE($HOROLOG,",",2)
+4 ;naked ref to tmp(rtfix,rate)
IF '$TEST
SET RATE=$PIECE(^("RATE"),"^")
SET RATE=(+$PIECE($HOROLOG,",",2))-RATE
+5 SET RATE=$JUSTIFY((RATE/60),5,1)
+6 ;naked ref to tmp(rtfix,rate)
SET ^("RATE")=$PIECE($HOROLOG,",",2)_"^"_RATE_"^"_RT
+7 ;stop if stopjob^rtfix
IF $DATA(^TMP("RTFIX","STOP"))
SET RT="Zend"
QUIT
+8 IF $$S^%ZTLOAD
SET RT="Zend"
SET ^TMP("RTFIX","STOP")=""
SET ZTSTOP=1
QUIT
+9 IF '$DATA(ZTQUEUED)
WRITE "."
End DoDot:2
+10 ;
+11 SET RTH=0
+12 FOR
SET RTH=$ORDER(^RTV(190.3,"B",RT,RTH))
if 'RTH
QUIT
Begin DoDot:2
+13 IF '$DATA(^RTV(190.3,RTH,0))
Begin DoDot:3
+14 LOCK +^RTV(190.3,RTH)
+15 if RTDB
KILL ^RTV(190.3,"B",RT,RTH)
LOCK -^RTV(190.3,RTH)
+16 SET ^TMP("RTFIX","XREF",RTH)=RT
+17 QUIT
End DoDot:3
QUIT
+18 IF +^RTV(190.3,RTH,0)'=RT
Begin DoDot:3
+19 ;naked ref to rtv(190.3,rth,0)
SET RTM0=^(0)
+20 IF 'RTM0
IF $DATA(^RT(RT,"CL"))
IF +$PIECE(^("CL"),"^",2)=RTH
QUIT
+21 LOCK +^RTV(190.3,RTH)
+22 if RTDB
KILL ^RTV(190.3,"B",RT,RTH)
LOCK -^RTV(190.3,RTH)
+23 SET DA=RTH
SET DIK="^RTV(190.3,"
+24 IF '$DATA(^RT(+RTM0,0))
if RTDB
DO ^DIK
SET ^TMP("RTFIX","XMOVE",RTH)=RT
QUIT
+25 IF RTM0
if RTDB
DO IX^DIK
SET ^TMP("RTFIX","XINDEX",RTH)=RT
+26 QUIT
End DoDot:3
QUIT
+27 QUIT
End DoDot:2
End DoDot:1
+28 ;
+29 LOCK -^TMP("RTFIX","START")
+30 DO NOW^%DTC
IF $DATA(^TMP("RTFIX","STOP"))
SET ^("STOP")=%_"^"_RTCT
NEW ZTSTOP
DO KILL
QUIT
+31 if RTDB
KILL ^TMP("RTFIX")
KILL DO KILL^XUSCLEAN
QUIT
+1 ;
QUE ;entry to queue with taskman from prog mode
+1 SET ZTIO=""
SET ZTRTN="EN^RTFIX"
SET ZTDESC="RT Check/Fix file 190.3"
+2 DO ^%ZTLOAD
QUIT
+3 ;
JOB SET ZTQUEUED=""
GOTO EN^RTFIX
QUIT
+1 ;
DEBUG SET RTDB=0
GOTO EN^RTFIX
QUIT
+1 ;
STOPJOB ;entry to stop job after about 1000 records if jobbed or tasked
+1 SET ^TMP("RTFIX","STOP")=""
+2 WRITE !?5,"The RTFIX routine will be stopping soon . . ."
QUIT
+3 ;
RATE ;entry to see how its going
+1 if '$DATA(^TMP("RTFIX","RATE"))
QUIT
+2 LOCK +^TMP("RTFIX","RATE")
+3 WRITE !?3,"Minutes/1K records = ",$PIECE(^TMP("RTFIX","RATE"),"^",2)
+4 WRITE !?3," Current Record # = ",$PIECE(^TMP("RTFIX","RATE"),"^",3)
+5 WRITE !?3," Last Record # = ",$PIECE(^RT(0),"^",3),!
+6 LOCK -^TMP("RTFIX","RATE")
QUIT
+7 ;
DOC ;The routine can run from programmer mode by
+1 ;D ^RTFIX
+2 ;
+3 ;The routine can be queued through TaskMan by
+4 ;D QUE^RTFIX
+5 ;
+6 ;The routine can be run in DEBUG mode by
+7 ;D DEBUG^RTFIX
+8 ;
+9 ;The routine can be stopped at any time by
+10 ;D STOPJOB^RTFIX or TBOX option for a taskman job
+11 ;
+12 ;The routine can be restarted where it left off as
+13 ;long as the global ^TMP("RTFIX" still exists.
+14 ;
+15 ;The status of the job can be monitored by
+16 ;D RATE^RTFIX
+17 ;
+18 ;XQ XUTL $J NODES option should be suspended on cpu when this
+19 ;routine is running to prevent ^TMP from being killed
+20 ;
+21 ;^TMP is only used to store start/stop and bad movements found
+22 ;
+23 ; Can be changed to use standard use of ^xtmp global by changing
+24 ; every ^tmp to ^xtmp. Will set nodes correctly to avoid xtmp
+25 ; purge.
+26 ;
+27 ;^TMP(nodes) description action
+28 ;
+29 ;^("XREF",RTMOV)=RT means a "B" entry with xref deleted
+30 ; no zero node
+31 ;^("XMOVE"... means no record movement deleted
+32 ;^("XINDEX"... means different record xref corrected
