| 1 | DIARB ;SFISC/TKW,WISC/CAP-ARCHIVING FUNCTIONS (CONT) ;4/24/96 10:55
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ENTE ;ADD/REMOVE ENTRIES TO SELECTED
|
|---|
| 5 | S DIC("A")="ADD/DELETE ENTRIES FROM ARCHIVAL ACTIVITY: " K DIARC D FILE^DIARU G Q:'$D(DIARC)
|
|---|
| 6 | S DIARCNT=0 K DIC
|
|---|
| 7 | D S DIC=+DIARF,DIC(0)="AEQMF",DIART=DIARF2,Z=0
|
|---|
| 8 | E W ! S DIC("W")="W:$D(^DIBT(DIARU,1,+Y)) "" *on "_$S($D(DIAX):"EXTRACT",1:"ARCHIVE")_" list*"" S DIARX="""" F DIARX2=0:0 S DIARX=$O(^DD(+DIARF,0,""ID"",DIARX)) Q:DIARX="""" S DIARX3=^(DIARX) I $D(@(DIC_""+Y,0)"")) X DIARX3"
|
|---|
| 9 | D ^DIC K DIC("W")
|
|---|
| 10 | I Y'>0 G QE
|
|---|
| 11 | S X=DIART G F:'X S Z=Z+1,%=$P($P(X,U,2),",",Z)
|
|---|
| 12 | G F:'% S $P(X,U)=$P($P(X,U),",",2,999),DIC=DIC_+Y_","_%_","
|
|---|
| 13 | I $D(@(DIC_"0)")),$P(^(0),U,2)-X=0 S DIART=X G E
|
|---|
| 14 | W !,$C(7),"No "_$O(^DD(+X,0,"NM",""))_" entry !!!",!
|
|---|
| 15 | G D
|
|---|
| 16 | F K DR S DA=+Y,DR=0 D EN^DIQ
|
|---|
| 17 | I '$D(^DIBT(DIARU,1,DA)) G E1
|
|---|
| 18 | S DIR(0)="Y",DIR("A")="DELETE this entry FROM the "_$S($D(DIAX):"EXTRACT",1:"ARCHIVAL")_" SELECTION",DIR("B")="YES"
|
|---|
| 19 | D ^DIR G QE:$D(DUOUT)!$D(DTOUT),QE:'$D(Y)
|
|---|
| 20 | I 'Y W !!,"OK, I left it IN !" G D
|
|---|
| 21 | S DIARCNT=DIARCNT+1,A=^DIAR(1.11,DIARC,0),$P(A,U,7)=$P(A,U,7)-1,$P(A,U,8)=2,^(0)=A
|
|---|
| 22 | K ^DIBT(DIARU,1,DA),@(DIC_DA_",-9)") W " Deleted"
|
|---|
| 23 | G D
|
|---|
| 24 | E1 S DIR(0)="Y",DIR("A")="ADD this entry TO the "_$S($D(DIAX):"EXTRACT",1:"ARCHIVAL")_" SELECTION",DIR("B")="YES"
|
|---|
| 25 | D ^DIR G QE:$D(DUOUT)!$D(DTOUT),QE:'$D(Y)
|
|---|
| 26 | I 'Y W !!,"OK, I left it OUT !" G D
|
|---|
| 27 | S DIARCNT=DIARCNT+1,A=^DIAR(1.11,DIARC,0),$P(A,U,7)=$P(A,U,7)+1,$P(A,U,8)=2,^(0)=A
|
|---|
| 28 | S ^DIBT(DIARU,1,DA)="" W " DONE"
|
|---|
| 29 | G D
|
|---|
| 30 | QE S:'DIARCNT DIAR="" D UPDATE^DIARU
|
|---|
| 31 | Q K DIAR,DIARC,DIARCNT,DIARD,DIARE,DIARF,DIARF0,DIARF1,DIARF2,DIARI,DIARP,DIARS,DIARST,DIART,DIARU,DIARX,DIAR
|
|---|
| 32 | K DIR,DIC,DIARL,DIARLINE,DIARBLNE,DIARPDEV,DIARPG,DIAX,DIAXFNO,DIAXNRB,DIAXMSG,DIARQUED,DIARTAB,DIARTRM,DIARXZ,DIARFLD,DIARFI,DIARXY
|
|---|
| 33 | K DIFILE,DIARXXX,DISTOP,DIARX2,DIARX3,DIPG,DIERR,DIOVRD
|
|---|
| 34 | Q
|
|---|
| 35 | ASK W !!,$C(7),"This extract activity has already updated the destination file.",!
|
|---|
| 36 | S DIR("A")="Delete the destination file entries created by this extract activity",DIR("B")="NO",DIR(0)="Y"
|
|---|
| 37 | S DIR("??")="^W !!?5,""Enter YES to rollback the destination file to its state before the update."""
|
|---|
| 38 | D ^DIR I 'Y S DIAXNRB=1
|
|---|
| 39 | Q
|
|---|
