53 lines
3.3 KiB
Mathematica
53 lines
3.3 KiB
Mathematica
NURSADEL ;CISC/MD/MH-PURGE ROUTINE FOR FILES 214.6 - 214.7 ;12/07/89
|
|
;;4.0;NURSING SERVICE;;Apr 25, 1997
|
|
EN1 ; ENTRY POINT TO PURGE DATA FROM FILES 214.6 AND 214.7
|
|
W !!,$C(7),"Has Nursing been contacted before purging data from files 214.6 and 214.7" S %=1 D YN^DICN
|
|
I %=0 W !!,$C(7),"ANSWER 'YES' or 'NO'" G EN1
|
|
I %=2 W !!!,$C(7),"Contact Nursing before proceeding!",! G Q
|
|
G:%'>0 Q
|
|
EN1A W !!,$C(7),"Has journaling of ^NURSA global been stopped" S %=1 D YN^DICN
|
|
I %=0 W !!,$C(7),"ANSWER 'YES' OR 'NO'" G EN1A
|
|
I %=2 W !!!,$C(7),"Stop journaling of ^NURSA global before proceeding!",! G Q
|
|
G:%'>0 Q
|
|
ASK W ! S NUROUT=0,U="^",X="T-6M",%DT="" D ^%DT S NURSDATE=+Y D D^DIQ S %DT("A")="Start With: ",%DT("B")=Y,%DT(0)=-NURSDATE,%DT="AEPT" D ^%DT G Q:+Y'>0 S NURSDATE=+Y
|
|
W !!,"Are you sure you want to delete data older than " D DT^DIQ S NURSDATE(1)=Y,%=1 D YN^DICN I '% W $C(7),!,?4,"ANSWER 'YES' OR 'NO':" G ASK
|
|
G ASK:%=2 Q:%'>0
|
|
D PURGE G:NUROUT Q D EN2,EN3
|
|
W !!,$C(7),"Purge is completed, journaling for the ^NURSA global should be restarted!"
|
|
S XQA("G.NURS-ADP")="",XQAMSG="Classification data older than "_NURSDATE(1)_" has been purged from the system." D SETUP^XQALERT
|
|
Q D ^NURSKILL
|
|
Q
|
|
PURGE ; ENTRY POINT TO PURGE DATA FROM THE NURSP(214.6 AND NURSP(214.7 GLOBALS
|
|
G:'$O(^NURSA(214.6,0)) AROUND W !!,"Purging 214.6 data.."
|
|
I '$D(^NURSA(214.6,"B")) W !,$C(7),"INCOMPLETE DATA FILE" S NUROUT=1 Q
|
|
F DA=0:0 S DA=$O(^NURSA(214.6,"B",DA)) Q:+DA>NURSDATE!(DA'>0) F IEN=0:0 S IEN=$O(^NURSA(214.6,"B",DA,IEN)) Q:IEN'>0 K ^NURSA(214.6,IEN) W "."
|
|
K ^NURSA(214.6,"B"),^NURSA(214.6,"C"),^NURSA(214.6,"AA"),^NURSA(214.6,"E"),^NURSA(214.6,"ACNT")
|
|
AROUND Q:'$O(^NURSA(214.7,0)) W !!,"Purging 214.7 data .."
|
|
I '$D(^NURSA(214.7,"B")),$O(^NURSA(214.7,0)) W !,$C(7),"INCOMPLETE DATA FILE" S NUROUT=1 Q
|
|
F DA=0:0 S DA=$O(^NURSA(214.7,"B",DA)) Q:+DA>NURSDATE!(DA'>0) F IEN=0:0 S IEN=$O(^NURSA(214.7,"B",DA,IEN)) Q:IEN'>0 K ^NURSA(214.7,IEN) W "."
|
|
K ^NURSA(214.7,"B"),^NURSA(214.7,"C"),^NURSA(214.7,"AA"),^NURSA(214.7,"ACNT"),^NURSA(214.7,"E")
|
|
Q
|
|
EN2 ;REINDEX FILES
|
|
Q:'$O(^NURSA(214.6,0)) W !,"Reindexing File 214.6 .."
|
|
S (NCT,NCT(1))=0 I $D(^NURSA(214.6,0)) F DA=0:0 S DA=$O(^NURSA(214.6,DA)) Q:DA'>0 S NCT=NCT+1,NCT(1)=DA_U_NCT W "." D INDX1
|
|
S $P(^NURSA(214.6,0),U,3,4)=$P(NCT(1),U,1,2)
|
|
Q
|
|
EN3 Q:'$O(^NURSA(214.7,0)) W !,"Reindexing File 214.7 .."
|
|
S (NCT,NCT(1))=0 I $D(^NURSA(214.7,0)) F DA=0:0 S DA=$O(^NURSA(214.7,DA)) Q:DA'>0 S NCT=NCT+1,NCT(1)=DA_U_NCT W "." D INDX2
|
|
S $P(^NURSA(214.7,0),U,3,4)=$P(NCT(1),1,2)
|
|
Q
|
|
INDX1 ;
|
|
S X=^NURSA(214.6,DA,0) I +$P(X,U) S ^NURSA(214.6,"B",+$P(X,U),DA)=""
|
|
I +$P(X,U,2) S ^NURSA(214.6,"C",+$P(X,U,2),DA)=""
|
|
I +$P(X,U),+$P(X,U,2) S ^NURSA(214.6,"AA",$P(X,U,2),9999999-$P(X,U),DA)=""
|
|
I +$P(X,U,8) S ^NURSA(214.6,"E",+$P(X,U,8),DA)=""
|
|
I $P(X,U,10)'="",+$P(X,U),+$P(X,U,8) S ZX=$S($P(X,U,10)="H":$P(X,U,10),$P(X,U,10)="R":$P(X,U,10),1:"") I ZX'="" S ^NURSA(214.6,"ACNT",$P(X,U)\1,+$P(X,U,8),ZX,DA)="" K X
|
|
Q
|
|
INDX2 ;
|
|
S X=^NURSA(214.7,DA,0) I +$P(X,U) S ^NURSA(214.7,"B",+$P(X,U),DA)=""
|
|
I +$P(X,U,2) S ^NURSA(214.7,"C",+$P(X,U,2),DA)=""
|
|
I +$P(X,U),+$P(X,U,2) S ^NURSA(214.7,"AA",$P(X,U,2),9999999-$P(X,U),DA)=""
|
|
I +$P(X,U,8) S ^NURSA(214.7,"E",+$P(X,U,8),DA)=""
|
|
I $P(X,U,10)'="",+$P(X,U),+$P(X,U,8) S ZX=$S($P(X,U,10)="H":$P(X,U,10),$P(X,U,10)="R":$P(X,U,10),1:"") I ZX'="" S ^NURSA(214.7,"ACNT",$P(X,U)\1,+$P(X,U,8),ZX,DA)="" K ZX
|
|
Q
|