source: FOIAVistA/trunk/r/PAID-PRS/PRSEDEL.m@ 770

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

initial load of FOIAVistA 6/30/08 version

File size: 1.5 KB
Line 
1PRSEDEL ;HISC/MD-PURGE ROUTINE FOR FILES 452/452.8 ;6/24/93
2 ;;4.0;PAID;;Sep 21, 1995
3EN1 ; ENTRY POINT TO PURGE DATA FROM FILE 452 FROM OPTION PRSE-STU-PURG
4 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
5 W !!,$C(7),"Has IRM been contacted before purging data from file 452",!,"to insure that journaling of the ^PRSE global has been suspended" S %=1 D YN^DICN
6 I %=0 W !!,$C(7),"ANSWER 'YES' or 'NO'" G EN1
7 I %=2 W !!!,$C(7),"Contact IRM to suspend ^PRSE global journaling before proceeding!",! G Q
8 G:%'>0 Q
9ASK W ! S POUT=0,U="^",X="T-156W",%DT="" D ^%DT D:+Y D^DIQ S PRSEDATE=Y,%DT("A")="Start With DATE: ",%DT("B")=PRSEDATE,%DT(0)=-DT,%DT="AEPT" D ^%DT G Q:+Y'>0 S PRSEDATE=+Y
10ASK1 W !!,"Are you sure you want to delete data prior to " D DT^DIQ S %=1 D YN^DICN I '% W $C(7),!,?4,"ANSWER 'YES' OR 'NO':" G ASK1
11 G Q:%<0 G ASK:%'=1
12 D G Q:$D(POUT)
13 . ; ENTRY POINT TO PURGE DATA FROM THE PRSE(452 GLOBAL
14 . I $G(^PRSE(452,0))="" S POUT=1 Q
15 . I '$D(^PRSE(452,"H")) W !,$C(7),"INCOMPLETE DATA FILE" S POUT=1 Q
16 . W !!,"Purging 452 data...." S DIK="^PRSE(452," F PDATE=0:0 S PDATE=$O(^PRSE(452,"H",PDATE)) Q:+PDATE>PRSEDATE!(PDATE'>0) F DA=0:0 S DA=$O(^PRSE(452,"H",PDATE,DA)) Q:DA'>0 I $P($G(^PRSE(452,DA,0)),U,2)'="" D
17 . . S X=$P($G(^PRSE(452,+DA,0)),U,2) I X'="" S PRDA=$O(^PRSE(452.1,"B",X,0)) I $P($G(^PRSE(452.1,+PRDA,0)),U,6)'="0" D ^DIK W "."
18 . . Q
19 . Q
20 W !!,$C(7),"Notify IRM that the purge is completed and that journaling for the ^PRSE",!,"global should be restarted!"
21Q D ^PRSEKILL
22 Q
Note: See TracBrowser for help on using the repository browser.