| [613] | 1 | DIARCALC ;SFISC/TKW,WISC/CAP-ARCHIVING Variables Doc / Misc Calc. ;10/7/95 07:29
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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 | K DO 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
|
|---|
