Return to DIARB.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIARB.m, revision 1.1

1.1     ! snw         1: DIARB  ;SFISC/TKW,WISC/CAP-ARCHIVING FUNCTIONS (CONT) ;9/2/94  06:31
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             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
        !            40:        ;
        !            41: 61     D EN^DIAXM Q:$G(DIERR)
        !            42:        W $C(7),!,"If entries cannot be moved to the destination file, an exception report",!,"will be printed.",!!,"Select a device which will save the report for later reference.",!
        !            43:        S DIE="^DIAR(1.11,",DA=DIARC,DIAXFNO=+$P(^DIPT(DIARP,0),U,9),DR="17////"_DIAXFNO
        !            44:        D ^DIE
        !            45:        K ^TMP("DIERR",$J) S DIERR=0
        !            46:        Q