source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARESTOR.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1RARESTOR ;HISC/SWM-Recover Purged Rad/NM Report/Exam only
2 ;;5.0;Radiology/Nuclear Medicine;**34**;Mar 16, 1998
3 ;
4 S:'$D(DTIME) DTIME=9999
5 I $G(^XTMP("RARECOV",0))="" W !,"^XTMP(""RARECOV"") doesn't exist -- there's no data to recover!" G Q
6 S RA1=0,RA2=0,RA3=0
7 S:$D(^XTMP("RARECOV","RPT")) RA1=1 S:$D(^XTMP("RARECOV","DPT")) RA2=1
8 I RA1,RA2 S RA3=1
9 W !,?7,"Radiology " W $S(RA3:"reports and exams",RA2:"exams",1:"reports")," were purged."
10 S RAIEN=0 F S RAIEN=$O(^XTMP("RARECOV",RAIEN)) Q:'RAIEN D
11 .S RAPUR(RAIEN)=""
12 . S Y=$P(^XTMP("RARECOV",0,RAIEN),"^"),RANUM=$P(^(RAIEN),"^",2) D DD^%DT S RADTDONE=Y
13 .W !!,"Imaging Type: ","**** ",$P($G(^RA(79.2,RAIEN,0)),"^")," ****"
14 .W " purged on ",RADTDONE," -",RANUM," days."
15 .W !,"Activity Log",?20,"Report",?40,"Clin History",?60,"Tracking Time"
16 .W !,"cut-off date",?20,"cut-off date",?40,"cut-off date",?60,"cut-off date"
17 .W !,"------------",?20,"------------",?40,"------------",?60,"------------"
18 .W ! S X=$P(^XTMP("RARECOV",RAIEN),"^") D TW
19 .W ?20 S X=$P(^(RAIEN),"^",2) D TW
20 .W ?40 S X=$P(^(RAIEN),"^",3) D TW
21 .W ?60 S X=$P(^(RAIEN),"^",4) D TW
22 .W !?5,"No. of exam records recovered: ",$P(^XTMP("RARECOV",RAIEN),"^",6)
23 .W !?5,"No. of reports recovered : ",$P(^XTMP("RARECOV",RAIEN),"^",7)
24 .Q
25 ;
26 W !!,?7,"The purged data were recovered"
27 S Y=$P(^XTMP("RARECOV",0),"^",2) D DD^%DT
28 W !,?7,"on ",Y," to ^XTMP(""RARECOV"")"
29 W !!,"This routine will restore the recovered data into the appropriate records."
30 ;
31 S DIR(0)="Y",DIR("A")="Do you want to proceed "
32 S DIR("B")="NO" D ^DIR
33 I 'Y W !!,"-- Nothing Done --" G Q
34 ;
35SET ;Set nodes by using recovered data from ^XTMP("RARECOV"
36 D NOW^%DTC S RANOW=%
37 W !!,"Restoring data to exams/reports",!
3870 G:'$D(^XTMP("RARECOV","DPT")) 74
39 S RADFN=0
40701 S RADFN=$O(^XTMP("RARECOV","DPT",RADFN)) G:'RADFN 74 S RADTI=0
41702 S RADTI=$O(^XTMP("RARECOV","DPT",RADFN,RADTI)) G:'RADTI 701 S RACNI=0
42703 S RACNI=$O(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI)) G:'RACNI 702
43 W "."
44 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=""
45 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=""
46 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=""
47 I $D(^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE")) S ^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE")=^XTMP("RARECOV","DPT",RADFN,RADTI,RACNI,"PURGE")
48 G 703
49 ;
5074 G:'$D(^XTMP("RARECOV","RPT")) DONE
51 S RARPT=0
52741 S RARPT=$O(^XTMP("RARECOV","RPT",RARPT)) G:'RARPT DONE
53 W "."
54 I $D(^XTMP("RARECOV","RPT",RARPT,"H")) M ^RARPT(RARPT,"H")=^XTMP("RARECOV","RPT",RARPT,"H")
55 I $D(^XTMP("RARECOV","RPT",RARPT,"L")) M ^RARPT(RARPT,"L")=^XTMP("RARECOV","RPT",RARPT,"L")
56 I $D(^XTMP("RARECOV","RPT",RARPT,"R")) M ^RARPT(RARPT,"R")=^XTMP("RARECOV","RPT",RARPT,"R")
57 I $D(^XTMP("RARECOV","RPT",RARPT,"PURGE")) S ^RARPT(RARPT,"PURGE")=^XTMP("RARECOV","RPT",RARPT,"PURGE")
58 G 741
59TW S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) W X
60 Q
61DONE W !!,"Data have been restored."
62Q ;K RA1,RADFN,RADTI,RACNI,RARPT
63 Q
Note: See TracBrowser for help on using the repository browser.