55 lines
2.3 KiB
Mathematica
55 lines
2.3 KiB
Mathematica
|
MAGDLB7 ;WOIFO/LB - Utilities for file 2006.575 ; [ 06/20/2001 08:56 ]
|
||
|
|
;;3.0;IMAGING;;Mar 01, 2002
|
||
|
|
;; +---------------------------------------------------------------+
|
||
|
|
;; | Property of the US Government. |
|
||
|
|
;; | No permission to copy or redistribute this software is given. |
|
||
|
|
;; | Use of unreleased versions of this software requires the user |
|
||
|
|
;; | to execute a written test agreement with the VistA Imaging |
|
||
|
|
;; | Development Office of the Department of Veterans Affairs, |
|
||
|
|
;; | telephone (301) 734-0100. |
|
||
|
|
;; | |
|
||
|
|
;; | The Food and Drug Administration classifies this software as |
|
||
|
|
;; | a medical device. As such, it may not be changed in any way. |
|
||
|
|
;; | Modifications to this software may result in an adulterated |
|
||
|
|
;; | medical device under 21CFR820, the use of which is considered |
|
||
|
|
;; | to be a violation of US Federal Statutes. |
|
||
|
|
;; +---------------------------------------------------------------+
|
||
|
|
;;
|
||
|
|
Q
|
||
|
|
REINDXF ;Reindex field 9 - Unique Study Identifications
|
||
|
|
N DIK
|
||
|
|
S DIK="^MAGD(2006.575,",DIK(1)="9"
|
||
|
|
D ENALL^DIK
|
||
|
|
Q
|
||
|
|
EN ;
|
||
|
|
N DIR,DDAY,X,Y,DOUT,DROUT,NOWDAY
|
||
|
|
W !,"Will re-index field 9, Unique Study Id."
|
||
|
|
D REINDXF
|
||
|
|
I '$D(^MAGD(2006.575,"F")) W !,"Nothing to process" Q
|
||
|
|
D NOW^%DTC S NOWDAY=X
|
||
|
|
W !,"Entries will be delete up to the date you specify."
|
||
|
|
EN1 ;restart point
|
||
|
|
S DIR(0)="DA",DIR("A")="Last date to keep."
|
||
|
|
S DIR("?")="Enter a date."
|
||
|
|
D ^DIR I 'Y!(Y="^") W !,"No date entered. Quitting." Q
|
||
|
|
S DDAY=Y I NOWDAY=DDAY W !,"Can not be today." G EN1
|
||
|
|
D PURGE
|
||
|
|
Q
|
||
|
|
PURGE ;
|
||
|
|
N DATEPROC,IEN,NIEN,ITEM,SUID
|
||
|
|
S IEN=0,SUID="" F S SUID=$O(^MAGD(2006.575,"F",SUID)) W !,SUID Q:SUID="" D
|
||
|
|
. F S IEN=$O(^MAGD(2006.575,"F",SUID,IEN)) W !,IEN Q:'IEN D
|
||
|
|
. . I '$D(^MAGD(2006.575,IEN,0)) D Q
|
||
|
|
. . . K ^MAGD(2006.575,"F",SUID,IEN) ;Tidy up.
|
||
|
|
. . S DATEPROC=$P(^MAGD(2006.575,IEN,1),"^",3)
|
||
|
|
. . I DATEPROC>DDAY Q
|
||
|
|
. . I $D(^MAGD(2006.575,IEN,"RLATE")) D
|
||
|
|
. . . ;start purging the related entries 1st before the parent entry
|
||
|
|
. . . S NIEN=0 F S NIEN=$O(^MAGD(2006.575,IEN,"RLATE",NIEN)) Q:'NIEN D
|
||
|
|
. . . . Q:'$D(^MAGD(2006.575,IEN,"RLATE",NIEN,0))
|
||
|
|
. . . . S ITEM=$P(^MAGD(2006.575,IEN,"RLATE",NIEN,0),"^") Q:'ITEM
|
||
|
|
. . . . D REMOVE^MAGDLB5(ITEM) W "."
|
||
|
|
. . D REMOVE^MAGDLB5(IEN) W "."
|
||
|
|
W !,"Finished."
|
||
|
|
Q
|