Annotation of freem_fileman/DIARCALC.m, revision 1.1

1.1     ! snw         1: DIARCALC       ;SFISC/TKW,WISC/CAP-ARCHIVING Variables Doc / Misc Calc. ;11/3/92  4:19 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5:        ;COMPUTE BOUNDARIES
        !             6: FROM   ;SELECT FROM VALUE 4 SORT
        !             7:        S X="F" D G
        !             8:        I $D(DIARS) S:A="" A=$P(DIARS,U,2) S:A="" A="FIRST" G Q
        !             9:        D H Q:X=""  S DIARS=Y_U_X Q
        !            10: TO     ;SELECT TO VALUE 4 SORT
        !            11:        S X="T" D G
        !            12:        I $D(DIARE) S:A="" A=$P(DIARE,U,2) S:A="" A="LAST" G Q
        !            13:        D H Q:X=""  S DIARE=Y_U_X Q
        !            14: G      S DIART=L,L=0 I $D(DIPP(DJ,X)) S A=$P(DIPP(DJ,X),U,2) Q
        !            15:        I $D(DPP(DJ,X)) S A=$P(DPP(DJ,X),U,2) Q
        !            16:        S A="" Q
        !            17: H      ;
        !            18:        S %=X,%1=DISV
        !            19:        I +%1,$D(^DIBT(%1,2,DJ,%)) S (X,%2)=$P(^(%),U,2) I "z"'[X
        !            20:        E  S %2=$S(%="T":"LAST",1:"FIRST"),X=""
        !            21:        I X="",'$D(DIAR) S A=%2,L=DIART G Q
        !            22:        D CK:X'=""
        !            23:        S L=DIART,A=$S(%="F"&(X]%2):X,%="T"&(%2]X)&(X'=""):X,A'="":A,1:%2)
        !            24: Q      K %,%1,%2,DIART Q
        !            25:        ;
        !            26: NEW    ;SET UP INITIAL ARCHIVAL ACTIVITY
        !            27:        D NOW^%DTC
        !            28:        S X=$P(^DIAR(1.11,0),U,3) F X=X:1 L +^DIAR(1.11,X):0 Q:$T&'$D(^(X))  L -^DIAR(1.11,X)
        !            29:        S Z="1////"_DIART_";4////"_DT_$S($D(^VA(200)):";8////"_DUZ,1:"")_";30////"_DIARF_";13////"_DIAR_";14////"_%_$S($D(^VA(200)):";15////"_DUZ,1:"")_";16////"_$S($D(DIAX):1,1:0)
        !            30:        I $D(DIARF0) S Z=Z_";31////"_DIARF0
        !            31:        S DINUM=X,DIC("DR")=Z
        !            32:        S DIC="^DIAR(1.11,",DIC(0)="EF"
        !            33:        D FILE^DICN S DIARC=+Y K DR
        !            34:        Q
        !            35:        ;
        !            36: CK     S DIART=%_U_%2_U_A D CK^DIP12
        !            37:        S %=$P(DIART,U,1),%2=$P(DIART,U,2),A=$P(DIART,U,3) Q
        !            38: VAR    ;
        !            39:        ;DIAR0 = List of human readable conditions from ^DOPT("DIS" in ^ pieces
        !            40:        ;DIARC = Internal record number of Archival Activity
        !            41:        ;DIARD = Array of information from default package archival search
        !            42:        ;        template for this file.  (Created in DIAR0)
        !            43:        ;DIARDC= Number of default conditions
        !            44:        ;DIARE = To value in DIP sort questions
        !            45:        ;DIARF = Internal number of file being archived
        !            46:        ;DIARF0= Subfile List or DIAR/DIBT INDEX
        !            47:        ;DIARI = SEARCH TEMPLATE USED
        !            48:        ;DIARF1=Level # that search is on
        !            49:        ;DIARP = Internal record no. of Filegram template
        !            50:        ;DIARS = Temporary value / From value in DIP sort questions
        !            51:        ;DIART = Temporary storage variable
        !            52:        ;DIARU = Internal number of Select Criteria Template
        !            53:        ;DIARST = Archival Activity upon entry to archival option

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>