RARECOV ;HISC/SWM-Recover Purged Rad/NM Report/Exam only ;4/17/03 09:39
;;5.0;Radiology/Nuclear Medicine;**34**;Mar 16, 1998
;
S:'$D(DTIME) DTIME=9999
I $D(^XTMP("RARECOV")) W !,"^XTMP(""RARECOV"") exists, you must delete this before",!,"you can run another recovery.",!! G NOTDONE
S RACRT=$E($G(IOST),1,2)="C-"
F I=1:1:21 W !,$P($T(INSTRC+I),";;",2)
R !,"Press return key to continue, or ""^"" to exit: ",X:DTIME
G:X="^" Q
;Select Imaging type(s)
;Return RAPUR array = RAPUR(ien)="", where ien = entry in 79.2
S (I,J,CNT)=0 K RAPUR
W !!?12,"IMAGING TYPES",!?12,"-------------",!
F S I=$O(^RA(79.2,"B",I)) Q:I="" F S J=$O(^RA(79.2,"B",I,J)) Q:'J S CNT=CNT+1 W !?3,CNT,") ",I S RAX(CNT)=J
W ! S DIR(0)="L^1:"_CNT,DIR("A")="Select Imaging Type(s) to recover purged data",DIR("?")="Select by number, one or more imaging types to be purged" D ^DIR K DIR I $D(DIRUT) G Q
S I="" F J=1:1 S I=$P(Y,",",J) Q:'I S RAPUR(RAX(I))=""
G Q:'$O(RAPUR(0))
;
;Select what to recover: exams, reports, or both
S DIR(0)="S^E:Exam data;R:Report data;B:Both;",DIR("?")="Do you want to recover purged Exams, Reports, or Both exams and reports"
S DIR("A")="Enter type of data to recover",DIR("B")="Report data"
D ^DIR K DIR
;REGET70=0 means don't recover file 70 data
S RAGET70=$S(Y="E":1,Y="B":1,1:0)
S RAGET74=$S(Y="R":1,Y="B":1,1:0)
;
S (RADT,RAIEN)=0
F S RAIEN=$O(RAPUR(RAIEN)) Q:'RAIEN D ASKDT Q:RAX=""!(CNT<4)
G:RAX=""!(CNT<4) NOTDONE
W !
S DIR(0)="Y",DIR("A")="Do you want to proceed "
S DIR("B")="NO" D ^DIR
I 'Y G NOTDONE
;
EXAM ;Copy backup exam/report data
D NOW^%DTC S RANOW=%,X1=RANOW,X2=60 D C^%DTC
S ^XTMP("RARECOV",0)=X_"^"_RANOW_"^"_"RARECOV"
W !!,"Recovering ",$S(RAGET70&RAGET74:"Exam and Report",RAGET70:"Exam",RAGET74:"Report",1:"?")," data from backup to ^XTMP(""RARECOV"".",!
F RADTE=0:0 S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RADT) S RADTI=9999999.9999-RADTE F RADFN=0:0 S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0 D
.F RACN=0:0 S RACN=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)) Q:RACN'>0 S RACNI=+$O(^(RACN,0)),RA0=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RARPT=+$P(RA0,"^",17) D
..S RAIMAG=+$P($G(^RAMIS(71,+$P(RA0,"^",2),0)),"^",12) Q:'$D(RAPUR(RAIMAG)) W:RACRT "."
..K RARP S RARPTNP=$G(^RARPT(RARPT,"NOPURGE")) I RAGET74 D
... Q:+$O(^RARPT(RARPT,"ERR",0)) ; quit if report amended
...I $P(RAPUR(RAIMAG),"^",2)>RADTE,$D(^RARPT(RARPT,"R")) M ^XTMP("RARECOV","RPT",RARPT,"R")=^RARPT(RARPT,"R") S RARP=""
...I $P(RAPUR(RAIMAG),"^")>RADTE,$D(^RARPT(RARPT,"L")) M ^XTMP("RARECOV","RPT",RARPT,"L")=^RARPT(RARPT,"L") S RARP=""
...I $P(RAPUR(RAIMAG),"^",3)>RADTE,$D(^RARPT(RARPT,"H")) M ^XTMP("RARECOV","RPT",RARPT,"H")=^RARPT(RARPT,"H") S RARP=""
..I $D(RARP) S ^XTMP("RARECOV","RPT",RARPT,"PURGE")=^RARPT(RARPT,"PURGE"),$P(RAPUR(RAIMAG),"^",7)=$P(RAPUR(RAIMAG),"^",7)+1
..K RAEX I RAGET70 D
...I $P(RAPUR(RAIMAG),"^")>RADTE,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L")) M ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"L")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L") S RAEX=""
...I $P(RAPUR(RAIMAG),"^",3)>RADTE,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H")) M ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"H")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H") S RAEX=""
...I $P(RAPUR(RAIMAG),"^",4)>RADTE,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T")) M ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"T")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T") S RAEX=""
..I $D(RAEX) S ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE"),$P(RAPUR(RAIMAG),"^",6)=$P(RAPUR(RAIMAG),"^",6)+1
;
D TOTALS G Q
INSTRC ;
;;Instructions for recovering purged exam and/or report data
;; Step 0.
;; Find out:
;; 1 - the DATE that the purge was done
;; 2 - how many DAYS back from that date was used as cut-off
;; ie., what was entered as "ddd" in "T-ddd" ?
;; Step 1. From the Backup Volume:
;; D ^RARECOV
;; enter cut-off dates that you had used in the purge function
;; Step 2. From the Backup Volume:
;; D ^%GTO (or your system's global copy out utility)
;; enter output file name
;; enter ^XTMP("RARECOV"
;; Step 3. From the Production volume that holds ^XTMP:
;; D ^%GTI (or your system's global restore utility)
;; enter the file name from step 2
;; Step 4. From the Production volume:
;; D ^RARESTOR
;; routine will automatically read from ^XTMP("RARECOV"
;; and copy data back into ^RADPT and/or ^RARPT
;;
NOTDONE W !!,"-- Nothing Done --"
Q ;K CNT,I,J,RADD,RADT,RAGET70,RAGET74,RAI,RAIEN,RAPRMPT,RAPUR,RAX
Q
TOTALS ;
S RAIEN=0
F S RAIEN=$O(RAPUR(RAIEN)) Q:'RAIEN D
. W !!,"Imaging Type: ",$P($G(^RA(79.2,RAIEN,0)),"^"),!
. W !?5,"No. of exam records recovered : ",$P(RAPUR(RAIEN),"^",6)
. W !?5,"No. of reports recovered : ",$P(RAPUR(RAIEN),"^",7)
. S ^XTMP("RARECOV",RAIEN)=RAPUR(RAIEN)
Q
;Select Cut-off date for the various data fields
ASKDT S RAX="",CNT=0
K RACUTDT W !!?7,"Cut-off Date Selection **** ",$P(^RA(79.2,RAIEN,0),"^")," ****"
K X,%DT S %DT="APEX" W !
S %DT("A")="Enter date that the Radiology Purge was done : " D ^%DT
G:'Y Q G:Y'?.7N Q S RADTDONE=Y
R !!,"Enter number of days subtracted from that date as cut-off : ",RANUM:DTIME
G:'RANUM Q
S ^XTMP("RARECOV",0,RAIEN)=RADTDONE_"^"_RANUM
S X1=RADTDONE,X2=-RANUM D C^%DTC S Y=X D DD^%DT S %DT("B")=Y
W !?7,"The default value can be changed as needed."
K RADD
S RAPRMPT="Cut-off Date for "
; define field names, because the backup volume doesn't have ^DD
S RADD(.11)="ACTIVITY LOG CUT-OFF"
S RADD(.12)="REPORT CUT-OFF"
S RADD(.13)="CLINICAL HISTORY CUT-OFF"
S RADD(.14)="TRACKING TIME CUT-OFF"
F RAI=.11:.01:.14 S CNT=CNT+1 D Q:Y<0
. W ! S %DT("A")=RAPRMPT_$P(RADD(RAI),"^")_" : " D ^%DT Q:Y<0 S $P(RAX,"^",CNT)=Y S:Y>RADT RADT=Y
G:RAX="" Q G:CNT<4 Q
S RAPUR(RAIEN)=RAX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARECOV 5982 printed Nov 22, 2024@17:49:01 Page 2
RARECOV ;HISC/SWM-Recover Purged Rad/NM Report/Exam only ;4/17/03 09:39
+1 ;;5.0;Radiology/Nuclear Medicine;**34**;Mar 16, 1998
+2 ;
+3 if '$DATA(DTIME)
SET DTIME=9999
+4 IF $DATA(^XTMP("RARECOV"))
WRITE !,"^XTMP(""RARECOV"") exists, you must delete this before",!,"you can run another recovery.",!!
GOTO NOTDONE
+5 SET RACRT=$EXTRACT($GET(IOST),1,2)="C-"
+6 FOR I=1:1:21
WRITE !,$PIECE($TEXT(INSTRC+I),";;",2)
+7 READ !,"Press return key to continue, or ""^"" to exit: ",X:DTIME
+8 if X="^"
GOTO Q
+9 ;Select Imaging type(s)
+10 ;Return RAPUR array = RAPUR(ien)="", where ien = entry in 79.2
+11 SET (I,J,CNT)=0
KILL RAPUR
+12 WRITE !!?12,"IMAGING TYPES",!?12,"-------------",!
+13 FOR
SET I=$ORDER(^RA(79.2,"B",I))
if I=""
QUIT
FOR
SET J=$ORDER(^RA(79.2,"B",I,J))
if 'J
QUIT
SET CNT=CNT+1
WRITE !?3,CNT,") ",I
SET RAX(CNT)=J
+14 WRITE !
SET DIR(0)="L^1:"_CNT
SET DIR("A")="Select Imaging Type(s) to recover purged data"
SET DIR("?")="Select by number, one or more imaging types to be purged"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO Q
+15 SET I=""
FOR J=1:1
SET I=$PIECE(Y,",",J)
if 'I
QUIT
SET RAPUR(RAX(I))=""
+16 if '$ORDER(RAPUR(0))
GOTO Q
+17 ;
+18 ;Select what to recover: exams, reports, or both
+19 SET DIR(0)="S^E:Exam data;R:Report data;B:Both;"
SET DIR("?")="Do you want to recover purged Exams, Reports, or Both exams and reports"
+20 SET DIR("A")="Enter type of data to recover"
SET DIR("B")="Report data"
+21 DO ^DIR
KILL DIR
+22 ;REGET70=0 means don't recover file 70 data
+23 SET RAGET70=$SELECT(Y="E":1,Y="B":1,1:0)
+24 SET RAGET74=$SELECT(Y="R":1,Y="B":1,1:0)
+25 ;
+26 SET (RADT,RAIEN)=0
+27 FOR
SET RAIEN=$ORDER(RAPUR(RAIEN))
if 'RAIEN
QUIT
DO ASKDT
if RAX=""!(CNT<4)
QUIT
+28 if RAX=""!(CNT<4)
GOTO NOTDONE
+29 WRITE !
+30 SET DIR(0)="Y"
SET DIR("A")="Do you want to proceed "
+31 SET DIR("B")="NO"
DO ^DIR
+32 IF 'Y
GOTO NOTDONE
+33 ;
EXAM ;Copy backup exam/report data
+1 DO NOW^%DTC
SET RANOW=%
SET X1=RANOW
SET X2=60
DO C^%DTC
+2 SET ^XTMP("RARECOV",0)=X_"^"_RANOW_"^"_"RARECOV"
+3 WRITE !!,"Recovering ",$SELECT(RAGET70&RAGET74:"Exam and Report",RAGET70:"Exam",RAGET74:"Report",1:"?")," data from backup to ^XTMP(""RARECOV"".",!
+4 FOR RADTE=0:0
SET RADTE=$ORDER(^RADPT("AR",RADTE))
if RADTE'>0!(RADTE>RADT)
QUIT
SET RADTI=9999999.9999-RADTE
FOR RADFN=0:0
SET RADFN=$ORDER(^RADPT("AR",RADTE,RADFN))
if RADFN'>0
QUIT
Begin DoDot:1
+5 FOR RACN=0:0
SET RACN=$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN))
if RACN'>0
QUIT
SET RACNI=+$ORDER(^(RACN,0))
SET RA0=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
SET RARPT=+$PIECE(RA0,"^",17)
Begin DoDot:2
+6 SET RAIMAG=+$PIECE($GET(^RAMIS(71,+$PIECE(RA0,"^",2),0)),"^",12)
if '$DATA(RAPUR(RAIMAG))
QUIT
if RACRT
WRITE "."
+7 KILL RARP
SET RARPTNP=$GET(^RARPT(RARPT,"NOPURGE"))
IF RAGET74
Begin DoDot:3
+8 ; quit if report amended
if +$ORDER(^RARPT(RARPT,"ERR",0))
QUIT
+9 IF $PIECE(RAPUR(RAIMAG),"^",2)>RADTE
IF $DATA(^RARPT(RARPT,"R"))
MERGE ^XTMP("RARECOV","RPT",RARPT,"R")=^RARPT(RARPT,"R")
SET RARP=""
+10 IF $PIECE(RAPUR(RAIMAG),"^")>RADTE
IF $DATA(^RARPT(RARPT,"L"))
MERGE ^XTMP("RARECOV","RPT",RARPT,"L")=^RARPT(RARPT,"L")
SET RARP=""
+11 IF $PIECE(RAPUR(RAIMAG),"^",3)>RADTE
IF $DATA(^RARPT(RARPT,"H"))
MERGE ^XTMP("RARECOV","RPT",RARPT,"H")=^RARPT(RARPT,"H")
SET RARP=""
End DoDot:3
+12 IF $DATA(RARP)
SET ^XTMP("RARECOV","RPT",RARPT,"PURGE")=^RARPT(RARPT,"PURGE")
SET $PIECE(RAPUR(RAIMAG),"^",7)=$PIECE(RAPUR(RAIMAG),"^",7)+1
+13 KILL RAEX
IF RAGET70
Begin DoDot:3
+14 IF $PIECE(RAPUR(RAIMAG),"^")>RADTE
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L"))
MERGE ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"L")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L")
SET RAEX=""
+15 IF $PIECE(RAPUR(RAIMAG),"^",3)>RADTE
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H"))
MERGE ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"H")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H")
SET RAEX=""
+16 IF $PIECE(RAPUR(RAIMAG),"^",4)>RADTE
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T"))
MERGE ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"T")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T")
SET RAEX=""
End DoDot:3
+17 IF $DATA(RAEX)
SET ^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE")=^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE")
SET $PIECE(RAPUR(RAIMAG),"^",6)=$PIECE(RAPUR(RAIMAG),"^",6)+1
End DoDot:2
End DoDot:1
+18 ;
+19 DO TOTALS
GOTO Q
INSTRC ;
+1 ;;Instructions for recovering purged exam and/or report data
+2 ;; Step 0.
+3 ;; Find out:
+4 ;; 1 - the DATE that the purge was done
+5 ;; 2 - how many DAYS back from that date was used as cut-off
+6 ;; ie., what was entered as "ddd" in "T-ddd" ?
+7 ;; Step 1. From the Backup Volume:
+8 ;; D ^RARECOV
+9 ;; enter cut-off dates that you had used in the purge function
+10 ;; Step 2. From the Backup Volume:
+11 ;; D ^%GTO (or your system's global copy out utility)
+12 ;; enter output file name
+13 ;; enter ^XTMP("RARECOV"
+14 ;; Step 3. From the Production volume that holds ^XTMP:
+15 ;; D ^%GTI (or your system's global restore utility)
+16 ;; enter the file name from step 2
+17 ;; Step 4. From the Production volume:
+18 ;; D ^RARESTOR
+19 ;; routine will automatically read from ^XTMP("RARECOV"
+20 ;; and copy data back into ^RADPT and/or ^RARPT
+21 ;;
NOTDONE WRITE !!,"-- Nothing Done --"
Q ;K CNT,I,J,RADD,RADT,RAGET70,RAGET74,RAI,RAIEN,RAPRMPT,RAPUR,RAX
+1 QUIT
TOTALS ;
+1 SET RAIEN=0
+2 FOR
SET RAIEN=$ORDER(RAPUR(RAIEN))
if 'RAIEN
QUIT
Begin DoDot:1
+3 WRITE !!,"Imaging Type: ",$PIECE($GET(^RA(79.2,RAIEN,0)),"^"),!
+4 WRITE !?5,"No. of exam records recovered : ",$PIECE(RAPUR(RAIEN),"^",6)
+5 WRITE !?5,"No. of reports recovered : ",$PIECE(RAPUR(RAIEN),"^",7)
+6 SET ^XTMP("RARECOV",RAIEN)=RAPUR(RAIEN)
End DoDot:1
+7 QUIT
+8 ;Select Cut-off date for the various data fields
ASKDT SET RAX=""
SET CNT=0
+1 KILL RACUTDT
WRITE !!?7,"Cut-off Date Selection **** ",$PIECE(^RA(79.2,RAIEN,0),"^")," ****"
+2 KILL X,%DT
SET %DT="APEX"
WRITE !
+3 SET %DT("A")="Enter date that the Radiology Purge was done : "
DO ^%DT
+4 if 'Y
GOTO Q
if Y'?.7N
GOTO Q
SET RADTDONE=Y
+5 READ !!,"Enter number of days subtracted from that date as cut-off : ",RANUM:DTIME
+6 if 'RANUM
GOTO Q
+7 SET ^XTMP("RARECOV",0,RAIEN)=RADTDONE_"^"_RANUM
+8 SET X1=RADTDONE
SET X2=-RANUM
DO C^%DTC
SET Y=X
DO DD^%DT
SET %DT("B")=Y
+9 WRITE !?7,"The default value can be changed as needed."
+10 KILL RADD
+11 SET RAPRMPT="Cut-off Date for "
+12 ; define field names, because the backup volume doesn't have ^DD
+13 SET RADD(.11)="ACTIVITY LOG CUT-OFF"
+14 SET RADD(.12)="REPORT CUT-OFF"
+15 SET RADD(.13)="CLINICAL HISTORY CUT-OFF"
+16 SET RADD(.14)="TRACKING TIME CUT-OFF"
+17 FOR RAI=.11:.01:.14
SET CNT=CNT+1
Begin DoDot:1
+18 WRITE !
SET %DT("A")=RAPRMPT_$PIECE(RADD(RAI),"^")_" : "
DO ^%DT
if Y<0
QUIT
SET $PIECE(RAX,"^",CNT)=Y
if Y>RADT
SET RADT=Y
End DoDot:1
if Y<0
QUIT
+19 if RAX=""
GOTO Q
if CNT<4
GOTO Q
+20 SET RAPUR(RAIEN)=RAX
+21 QUIT
