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>