source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPURGE.m@ 1073

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1RAPURGE ;HISC/CAH - AISC/MJK - Schedule Data Purge ;4/17/03 08:45
2 ;;5.0;Radiology/Nuclear Medicine;**34,41**;Mar 16, 1998
3SCH ;Edit purge parameters and schedule Rad/Nuc Med data purge
4 I '($D(DUZ)#2) W !!,$C(7),"No 'DUZ' code. Purging not allowed.",! Q
5 I '$D(^VA(200,DUZ,0)) W !!,$C(7),"Not a valid 'DUZ' code. Purging not allowed.",! Q
6 F I=1:1:15 W !?9,$P($T(REMIND+I),";;",2)
7 S DIR(0)="Y",DIR("B")="Yes",DIR("?")="Enter 'YES' or 'RETURN' to edit purge parameters, or 'NO' not to.",DIR("A")="Do you want to edit the Imaging Type purge parameters" D ^DIR K DIR G QB:$D(DIRUT),PURGE:'Y
8EDIT W !! S DIC="^RA(79.2,",DIC(0)="AEQM",DIC("A")="Select IMAGING TYPE: " D ^DIC K DIC I Y>0 S DA=+Y,DIE="^RA(79.2,",DIE("NO^")="",DR="[RA ON-LINE CRITERIA]" D ^DIE K DE,DQ,DIC,DIE,DR G EDIT
9PURGE W ! S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you wish to schedule the data purge",DIR("?")="Enter 'YES' to schedule the data purge, or 'NO' not to."
10 D ^DIR K DIR I $D(DIRUT)!(Y=0) G QB
11 D RECORD
12 ; Display entries from 79.2 for selection
13 N I,J,CNT,RAX S (I,J,CNT)=0 K RAPUR
14 W !!?12,"IMAGING TYPES",!?12,"-------------",!
15 ; RAX(sequential no.)=ien file 79.2
16 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
17 W ! S DIR(0)="L^1:"_CNT,DIR("A")="Select Imaging Type(s) to Purge",DIR("?")="Select by number, one or more imaging types to be purged" D ^DIR K DIR I $D(DIRUT) G QB
18 ; RAPUR(ien file 79.2)=""
19 S I="" F J=1:1 S I=$P(Y,",",J) Q:'I S RAPUR(RAX(I))=""
20 W ! S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you wish to re-purge records that have been purged in the past",DIR("?")="Enter 'YES' to re-purge records purged in the past, or 'NO' not to."
21 D ^DIR K DIR G QB:$D(DIRUT) S RAREPURG=Y
22 D ASKF
23 G:'RAGO QB
24 K RAX S RAX="" F S RAX=$O(RAPUR(RAX)) Q:'RAX S DA=RAX,DIE="^RA(79.2,",DR="100///""NOW""",DR(2,79.23)="2///S;3////"_DUZ D ^DIE
25 K DA,DE,DIE,DQ,DR
26 S ZTRTN="START^RAPURGE1",ZTSAVE("RAPUR*")="",ZTSAVE("RAREPURG")="",ZTDESC="Rad/Nuc Med Data Purge" W ! D ZIS^RAUTL G Q:RAPOP
27 G START^RAPURGE1
28QB W !,"--Nothing Done--"
29Q K D0,D1,DA,DLAYGO,POP,RAPOP,RAPR,RAPUR,RAREPURG,X,Y,ZTDESC,ZTRTN,ZTSAVE,RAMES,RAGO,RAPURTYP Q
30 ;
31RECORD ; select which records to purge
32 S DIR(0)="S^E:Exams only;R:Reports only;B:Both exams & reports;"
33 S DIR("?")="Do you want to purge Exams, Reports, Exams & Reports ?"
34 S DIR("A")="Enter type of data to purge"
35 S DIR("B")="Reports only"
36 D ^DIR K DIR
37 S RAPURTYP=Y
38 Q
39ASKF ;ask final question
40 S RAGO=0
41 W !!,"You have chosen to purge ",$S(RAPURTYP="E":"Exam",RAPURTYP="R":"Report",RAPURTYP="B":"Exam & Report",1:"?")," records from "
42 S I=""
43 F S I=$O(RAPUR(I)) Q:'I W " ",$P(^RA(79.2,I,0),U) W:$O(RAPUR(I)) ","
44 W !
45 S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you wish to proceed with the purge"
46 S DIR("?")="Enter 'YES' to go ahead with the purge, or 'NO' to exit from this option."
47 D ^DIR K DIR
48 S RAGO=Y
49 Q
50REMIND ;
51 ;;+--------------------------------------------------------+
52 ;;| This option is used to remove data from one or all of |
53 ;;| these globals: ^RADPT, ^RARPT |
54 ;;| |
55 ;;| Make sure IRM keeps the backup that was made prior to |
56 ;;| running this option, and NOT overwrite that backup for |
57 ;;| at least 6 months. Data from ^RADPT and ^RARPT can be |
58 ;;| recovered. |
59 ;;| |
60 ;;| The cut-off dates for the 4 items (activity log, |
61 ;;| report, clinical history, tracking time) are |
62 ;;| compared to the exam date of those items. If the |
63 ;;| exam date for an item is older than the cut-off date |
64 ;;| for that item, then that item would be purged. |
65 ;;+--------------------------------------------------------+
66 ;;
67 Q
Note: See TracBrowser for help on using the repository browser.