- DIARB ;SFISC/TKW,WISC/CAP-ARCHIVING FUNCTIONS (CONT) ;4/24/96 10:55
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ENTE ;ADD/REMOVE ENTRIES TO SELECTED
- S DIC("A")="ADD/DELETE ENTRIES FROM ARCHIVAL ACTIVITY: " K DIARC D FILE^DIARU G Q:'$D(DIARC)
- S DIARCNT=0 K DIC
- D S DIC=+DIARF,DIC(0)="AEQMF",DIART=DIARF2,Z=0
- 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"
- D ^DIC K DIC("W")
- I Y'>0 G QE
- S X=DIART G F:'X S Z=Z+1,%=$P($P(X,U,2),",",Z)
- G F:'% S $P(X,U)=$P($P(X,U),",",2,999),DIC=DIC_+Y_","_%_","
- I $D(@(DIC_"0)")),$P(^(0),U,2)-X=0 S DIART=X G E
- W !,$C(7),"No "_$O(^DD(+X,0,"NM",""))_" entry !!!",!
- G D
- F K DR S DA=+Y,DR=0 D EN^DIQ
- I '$D(^DIBT(DIARU,1,DA)) G E1
- S DIR(0)="Y",DIR("A")="DELETE this entry FROM the "_$S($D(DIAX):"EXTRACT",1:"ARCHIVAL")_" SELECTION",DIR("B")="YES"
- D ^DIR G QE:$D(DUOUT)!$D(DTOUT),QE:'$D(Y)
- I 'Y W !!,"OK, I left it IN !" G D
- 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
- K ^DIBT(DIARU,1,DA),@(DIC_DA_",-9)") W " Deleted"
- G D
- E1 S DIR(0)="Y",DIR("A")="ADD this entry TO the "_$S($D(DIAX):"EXTRACT",1:"ARCHIVAL")_" SELECTION",DIR("B")="YES"
- D ^DIR G QE:$D(DUOUT)!$D(DTOUT),QE:'$D(Y)
- I 'Y W !!,"OK, I left it OUT !" G D
- 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
- S ^DIBT(DIARU,1,DA)="" W " DONE"
- G D
- QE S:'DIARCNT DIAR="" D UPDATE^DIARU
- Q K DIAR,DIARC,DIARCNT,DIARD,DIARE,DIARF,DIARF0,DIARF1,DIARF2,DIARI,DIARP,DIARS,DIARST,DIART,DIARU,DIARX,DIAR
- K DIR,DIC,DIARL,DIARLINE,DIARBLNE,DIARPDEV,DIARPG,DIAX,DIAXFNO,DIAXNRB,DIAXMSG,DIARQUED,DIARTAB,DIARTRM,DIARXZ,DIARFLD,DIARFI,DIARXY
- K DIFILE,DIARXXX,DISTOP,DIARX2,DIARX3,DIPG,DIERR,DIOVRD
- Q
- ASK W !!,$C(7),"This extract activity has already updated the destination file.",!
- S DIR("A")="Delete the destination file entries created by this extract activity",DIR("B")="NO",DIR(0)="Y"
- S DIR("??")="^W !!?5,""Enter YES to rollback the destination file to its state before the update."""
- D ^DIR I 'Y S DIAXNRB=1
- Q
- DIARB ;SFISC/TKW,WISC/CAP-ARCHIVING FUNCTIONS (CONT) ;4/24/96 10:55
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- ENTE ;ADD/REMOVE ENTRIES TO SELECTED
- +1 SET DIC("A")="ADD/DELETE ENTRIES FROM ARCHIVAL ACTIVITY: "
- KILL DIARC
- DO FILE^DIARU
- IF '$DATA(DIARC)
- GOTO Q
- +2 SET DIARCNT=0
- KILL DIC
- D SET DIC=+DIARF
- SET DIC(0)="AEQMF"
- SET DIART=DIARF2
- SET Z=0
- E WRITE !
- SET DIARB_source.html#xD">DIC("W")="W:$DIARB_source.html#xD">D(^DIARB_source.html#xD">DIBT(DIARB_source.html#xD">DIARU,1,+Y)) "" *on "_$SELECT($DIARB_source.html#xD">DATA(DIARB_source.html#xD">DIAX):"EXTRACT",1:"ARCHIVE")_" list*"" S DIARB_source.html#xD">DIARX="""" F DIARB_source.html#xD">DIARX2=0:0 S DIARB_source.html#xD">DIARX=$O(^DIARB_source.html#xD">DDIARB_source.html#xD">D(+DIARB_source.html#xD">DIARF,0,""IDIARB_source.html#xD">D"",DIARB_source.html#xD">DIARX)) Q:DIARB_source.html#xD">DIARX="""" S DIARB_source.html#xD">DIARX3=^(DIARB_source.html#xD">DIARX) I $DIARB_source.html#xD">D(@(DIARB_source.html#xD">DIC_""+Y,0)"")) X DIARB_source.html#xD">DIARX3"
- +1 DO ^DIC
- KILL DIC("W")
- +2 IF Y'>0
- GOTO QE
- +3 SET X=DIART
- IF 'X
- GOTO F
- SET Z=Z+1
- SET %=$PIECE($PIECE(X,U,2),",",Z)
- +4 IF '%
- GOTO F
- SET $PIECE(X,U)=$PIECE($PIECE(X,U),",",2,999)
- SET DIC=DIC_+Y_","_%_","
- +5 IF $DATA(@(DIC_"0)"))
- IF $PIECE(^(0),U,2)-X=0
- SET DIART=X
- GOTO E
- +6 WRITE !,$CHAR(7),"No "_$ORDER(^DD(+X,0,"NM",""))_" entry !!!",!
- +7 GOTO D
- F KILL DR
- SET DA=+Y
- SET DR=0
- DO EN^DIQ
- +1 IF '$DATA(^DIBT(DIARU,1,DA))
- GOTO E1
- +2 SET DIR(0)="Y"
- SET DIR("A")="DELETE this entry FROM the "_$SELECT($DATA(DIAX):"EXTRACT",1:"ARCHIVAL")_" SELECTION"
- SET DIR("B")="YES"
- +3 DO ^DIR
- IF $DATA(DUOUT)!$DATA(DTOUT)
- GOTO QE
- IF '$DATA(Y)
- GOTO QE
- +4 IF 'Y
- WRITE !!,"OK, I left it IN !"
- GOTO D
- +5 SET DIARCNT=DIARCNT+1
- SET A=^DIAR(1.11,DIARC,0)
- SET $PIECE(A,U,7)=$PIECE(A,U,7)-1
- SET $PIECE(A,U,8)=2
- SET ^(0)=A
- +6 KILL ^DIBT(DIARU,1,DA),@(DIC_DA_",-9)")
- WRITE " Deleted"
- +7 GOTO D
- E1 SET DIR(0)="Y"
- SET DIR("A")="ADD this entry TO the "_$SELECT($DATA(DIAX):"EXTRACT",1:"ARCHIVAL")_" SELECTION"
- SET DIR("B")="YES"
- +1 DO ^DIR
- IF $DATA(DUOUT)!$DATA(DTOUT)
- GOTO QE
- IF '$DATA(Y)
- GOTO QE
- +2 IF 'Y
- WRITE !!,"OK, I left it OUT !"
- GOTO D
- +3 SET DIARCNT=DIARCNT+1
- SET A=^DIAR(1.11,DIARC,0)
- SET $PIECE(A,U,7)=$PIECE(A,U,7)+1
- SET $PIECE(A,U,8)=2
- SET ^(0)=A
- +4 SET ^DIBT(DIARU,1,DA)=""
- WRITE " DONE"
- +5 GOTO D
- QE IF 'DIARCNT
- SET DIAR=""
- DO UPDATE^DIARU
- Q KILL DIAR,DIARC,DIARCNT,DIARD,DIARE,DIARF,DIARF0,DIARF1,DIARF2,DIARI,DIARP,DIARS,DIARST,DIART,DIARU,DIARX,DIAR
- +1 KILL DIR,DIC,DIARL,DIARLINE,DIARBLNE,DIARPDEV,DIARPG,DIAX,DIAXFNO,DIAXNRB,DIAXMSG,DIARQUED,DIARTAB,DIARTRM,DIARXZ,DIARFLD,DIARFI,DIARXY
- +2 KILL DIFILE,DIARXXX,DISTOP,DIARX2,DIARX3,DIPG,DIERR,DIOVRD
- +3 QUIT
- ASK WRITE !!,$CHAR(7),"This extract activity has already updated the destination file.",!
- +1 SET DIR("A")="Delete the destination file entries created by this extract activity"
- SET DIR("B")="NO"
- SET DIR(0)="Y"
- +2 SET DIR("??")="^W !!?5,""Enter YES to rollback the destination file to its state before the update."""
- +3 DO ^DIR
- IF 'Y
- SET DIAXNRB=1
- +4 QUIT
