RARESTOR ;HISC/SWM-Recover Purged Rad/NM Report/Exam only
;;5.0;Radiology/Nuclear Medicine;**34**;Mar 16, 1998
;
S:'$D(DTIME) DTIME=9999
I $G(^XTMP("RARECOV",0))="" W !,"^XTMP(""RARECOV"") doesn't exist -- there's no data to recover!" G Q
S RA1=0,RA2=0,RA3=0
S:$D(^XTMP("RARECOV","RPT")) RA1=1 S:$D(^XTMP("RARECOV","DPT")) RA2=1
I RA1,RA2 S RA3=1
W !,?7,"Radiology " W $S(RA3:"reports and exams",RA2:"exams",1:"reports")," were purged."
S RAIEN=0 F S RAIEN=$O(^XTMP("RARECOV",RAIEN)) Q:'RAIEN D
.S RAPUR(RAIEN)=""
. S Y=$P(^XTMP("RARECOV",0,RAIEN),"^"),RANUM=$P(^(RAIEN),"^",2) D DD^%DT S RADTDONE=Y
.W !!,"Imaging Type: ","**** ",$P($G(^RA(79.2,RAIEN,0)),"^")," ****"
.W " purged on ",RADTDONE," -",RANUM," days."
.W !,"Activity Log",?20,"Report",?40,"Clin History",?60,"Tracking Time"
.W !,"cut-off date",?20,"cut-off date",?40,"cut-off date",?60,"cut-off date"
.W !,"------------",?20,"------------",?40,"------------",?60,"------------"
.W ! S X=$P(^XTMP("RARECOV",RAIEN),"^") D TW
.W ?20 S X=$P(^(RAIEN),"^",2) D TW
.W ?40 S X=$P(^(RAIEN),"^",3) D TW
.W ?60 S X=$P(^(RAIEN),"^",4) D TW
.W !?5,"No. of exam records recovered: ",$P(^XTMP("RARECOV",RAIEN),"^",6)
.W !?5,"No. of reports recovered : ",$P(^XTMP("RARECOV",RAIEN),"^",7)
.Q
;
W !!,?7,"The purged data were recovered"
S Y=$P(^XTMP("RARECOV",0),"^",2) D DD^%DT
W !,?7,"on ",Y," to ^XTMP(""RARECOV"")"
W !!,"This routine will restore the recovered data into the appropriate records."
;
S DIR(0)="Y",DIR("A")="Do you want to proceed "
S DIR("B")="NO" D ^DIR
I 'Y W !!,"-- Nothing Done --" G Q
;
SET ;Set nodes by using recovered data from ^XTMP("RARECOV"
D NOW^%DTC S RANOW=%
W !!,"Restoring data to exams/reports",!
70 G:'$D(^XTMP("RARECOV","DPT")) 74
S RADFN=0
701 S RADFN=$O(^XTMP("RARECOV","DPT",RADFN)) G:'RADFN 74 S RADTI=0
702 S RADTI=$O(^XTMP("RARECOV","DPT",RADFN,RADTI)) G:'RADTI 701 S RACNI=0
703 S RACNI=$O(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI)) G:'RACNI 702
W "."
I $D(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"L")) M ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"L") S RAEX=""
I $D(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"H")) M ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"H") S RAEX=""
I $D(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"T")) M ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"T") S RAEX=""
I $D(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE")) S ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE")
G 703
;
74 G:'$D(^XTMP("RARECOV","RPT")) DONE
S RARPT=0
741 S RARPT=$O(^XTMP("RARECOV","RPT",RARPT)) G:'RARPT DONE
W "."
I $D(^XTMP("RARECOV","RPT",RARPT,"H")) M ^RARPT(RARPT,"H")=^XTMP("RARECOV","RPT",RARPT,"H")
I $D(^XTMP("RARECOV","RPT",RARPT,"L")) M ^RARPT(RARPT,"L")=^XTMP("RARECOV","RPT",RARPT,"L")
I $D(^XTMP("RARECOV","RPT",RARPT,"R")) M ^RARPT(RARPT,"R")=^XTMP("RARECOV","RPT",RARPT,"R")
I $D(^XTMP("RARECOV","RPT",RARPT,"PURGE")) S ^RARPT(RARPT,"PURGE")=^XTMP("RARECOV","RPT",RARPT,"PURGE")
G 741
TW S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W X
Q
DONE W !!,"Data have been restored."
Q ;K RA1,RADFN,RADTI,RACNI,RARPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARESTOR 3282 printed Apr 09, 2024@21:36:59 Page 2
RARESTOR ;HISC/SWM-Recover Purged Rad/NM Report/Exam only
+1 ;;5.0;Radiology/Nuclear Medicine;**34**;Mar 16, 1998
+2 ;
+3 if '$DATA(DTIME)
SET DTIME=9999
+4 IF $GET(^XTMP("RARECOV",0))=""
WRITE !,"^XTMP(""RARECOV"") doesn't exist -- there's no data to recover!"
GOTO Q
+5 SET RA1=0
SET RA2=0
SET RA3=0
+6 if $DATA(^XTMP("RARECOV","RPT"))
SET RA1=1
if $DATA(^XTMP("RARECOV","DPT"))
SET RA2=1
+7 IF RA1
IF RA2
SET RA3=1
+8 WRITE !,?7,"Radiology "
WRITE $SELECT(RA3:"reports and exams",RA2:"exams",1:"reports")," were purged."
+9 SET RAIEN=0
FOR
SET RAIEN=$ORDER(^XTMP("RARECOV",RAIEN))
if 'RAIEN
QUIT
Begin DoDot:1
+10 SET RAPUR(RAIEN)=""
+11 SET Y=$PIECE(^XTMP("RARECOV",0,RAIEN),"^")
SET RANUM=$PIECE(^(RAIEN),"^",2)
DO DD^%DT
SET RADTDONE=Y
+12 WRITE !!,"Imaging Type: ","**** ",$PIECE($GET(^RA(79.2,RAIEN,0)),"^")," ****"
+13 WRITE " purged on ",RADTDONE," -",RANUM," days."
+14 WRITE !,"Activity Log",?20,"Report",?40,"Clin History",?60,"Tracking Time"
+15 WRITE !,"cut-off date",?20,"cut-off date",?40,"cut-off date",?60,"cut-off date"
+16 WRITE !,"------------",?20,"------------",?40,"------------",?60,"------------"
+17 WRITE !
SET X=$PIECE(^XTMP("RARECOV",RAIEN),"^")
DO TW
+18 WRITE ?20
SET X=$PIECE(^(RAIEN),"^",2)
DO TW
+19 WRITE ?40
SET X=$PIECE(^(RAIEN),"^",3)
DO TW
+20 WRITE ?60
SET X=$PIECE(^(RAIEN),"^",4)
DO TW
+21 WRITE !?5,"No. of exam records recovered: ",$PIECE(^XTMP("RARECOV",RAIEN),"^",6)
+22 WRITE !?5,"No. of reports recovered : ",$PIECE(^XTMP("RARECOV",RAIEN),"^",7)
+23 QUIT
End DoDot:1
+24 ;
+25 WRITE !!,?7,"The purged data were recovered"
+26 SET Y=$PIECE(^XTMP("RARECOV",0),"^",2)
DO DD^%DT
+27 WRITE !,?7,"on ",Y," to ^XTMP(""RARECOV"")"
+28 WRITE !!,"This routine will restore the recovered data into the appropriate records."
+29 ;
+30 SET DIR(0)="Y"
SET DIR("A")="Do you want to proceed "
+31 SET DIR("B")="NO"
DO ^DIR
+32 IF 'Y
WRITE !!,"-- Nothing Done --"
GOTO Q
+33 ;
SET ;Set nodes by using recovered data from ^XTMP("RARECOV"
+1 DO NOW^%DTC
SET RANOW=%
+2 WRITE !!,"Restoring data to exams/reports",!
70 if '$DATA(^XTMP("RARECOV","DPT"))
GOTO 74
+1 SET RADFN=0
701 SET RADFN=$ORDER(^XTMP("RARECOV","DPT",RADFN))
if 'RADFN
GOTO 74
SET RADTI=0
702 SET RADTI=$ORDER(^XTMP("RARECOV","DPT",RADFN,RADTI))
if 'RADTI
GOTO 701
SET RACNI=0
703 SET RACNI=$ORDER(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI))
if 'RACNI
GOTO 702
+1 WRITE "."
+2 IF $DATA(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"L"))
MERGE ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"L")
SET RAEX=""
+3 IF $DATA(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"H"))
MERGE ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"H")
SET RAEX=""
+4 IF $DATA(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"T"))
MERGE ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"T")
SET RAEX=""
+5 IF $DATA(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE"))
SET ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE")
+6 GOTO 703
+7 ;
74 if '$DATA(^XTMP("RARECOV","RPT"))
GOTO DONE
+1 SET RARPT=0
741 SET RARPT=$ORDER(^XTMP("RARECOV","RPT",RARPT))
if 'RARPT
GOTO DONE
+1 WRITE "."
+2 IF $DATA(^XTMP("RARECOV","RPT",RARPT,"H"))
MERGE ^RARPT(RARPT,"H")=^XTMP("RARECOV","RPT",RARPT,"H")
+3 IF $DATA(^XTMP("RARECOV","RPT",RARPT,"L"))
MERGE ^RARPT(RARPT,"L")=^XTMP("RARECOV","RPT",RARPT,"L")
+4 IF $DATA(^XTMP("RARECOV","RPT",RARPT,"R"))
MERGE ^RARPT(RARPT,"R")=^XTMP("RARECOV","RPT",RARPT,"R")
+5 IF $DATA(^XTMP("RARECOV","RPT",RARPT,"PURGE"))
SET ^RARPT(RARPT,"PURGE")=^XTMP("RARECOV","RPT",RARPT,"PURGE")
+6 GOTO 741
TW SET X=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
WRITE X
+1 QUIT
DONE WRITE !!,"Data have been restored."
Q ;K RA1,RADFN,RADTI,RACNI,RARPT
+1 QUIT
