- 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
- 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
