Return to DIARCALC.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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