Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIARCALC

DIARCALC.m

Go to the documentation of this file.
  1. DIARCALC ;SFISC/TKW,WISC/CAP-ARCHIVING Variables Doc / Misc Calc.;06:10 PM 5 Dec 1999
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ;COMPUTE BOUNDARIES
  1. FROM ;SELECT FROM VALUE 4 SORT
  1. S X="F" D G
  1. FIRST I $D(DIARS) S:A="" A=$P(DIARS,U,2) S:A="" A=$$EZBLD^DIALOG(7070) G Q ;**CCO/NI 'FIRST'
  1. D H Q:X="" S DIARS=Y_U_X Q
  1. TO ;SELECT TO VALUE 4 SORT
  1. S X="T" D G
  1. LAST I $D(DIARE) S:A="" A=$P(DIARE,U,2) S:A="" A=$$EZBLD^DIALOG(7071) G Q ;**CCO/NI 'LAST'
  1. D H Q:X="" S DIARE=Y_U_X Q
  1. G S DIART=L,L=0 I $D(DIPP(DJ,X)) S A=$P(DIPP(DJ,X),U,2) Q
  1. I $D(DPP(DJ,X)) S A=$P(DPP(DJ,X),U,2) Q
  1. S A="" Q
  1. H ;
  1. S %=X,%1=DISV
  1. I +%1,$D(^DIBT(%1,2,DJ,%)) S (X,%2)=$P(^(%),U,2) I "z"'[X
  1. EGP E S %2=$S(%="T":$$EZBLD^DIALOG(7071),1:$$EZBLD^DIALOG(7070)),X="" ;**CCO/NI 'FIRST' OR 'LAST'
  1. I X="",'$D(DIAR) S A=%2,L=DIART G Q
  1. D CK:X'=""
  1. S L=DIART,A=$S(%="F"&(X]%2):X,%="T"&(%2]X)&(X'=""):X,A'="":A,1:%2)
  1. Q K %,%1,%2,DIART Q
  1. ;
  1. NEW ;SET UP INITIAL ARCHIVAL ACTIVITY
  1. D NOW^%DTC
  1. 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)
  1. 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)
  1. I $D(DIARF0) S Z=Z_";31////"_DIARF0
  1. S DINUM=X,DIC("DR")=Z
  1. S DIC="^DIAR(1.11,",DIC(0)="EF"
  1. K DO D FILE^DICN S DIARC=+Y K DR
  1. Q
  1. ;
  1. CK S DIART=%_U_%2_U_A D CK^DIP12
  1. S %=$P(DIART,U,1),%2=$P(DIART,U,2),A=$P(DIART,U,3) Q
  1. VAR ;
  1. ;DIAR0 = List of human readable conditions from ^DOPT("DIS" in ^ pieces
  1. ;DIARC = Internal record number of Archival Activity
  1. ;DIARD = Array of information from default package archival search
  1. ; template for this file. (Created in DIAR0)
  1. ;DIARDC= Number of default conditions
  1. ;DIARE = To value in DIP sort questions
  1. ;DIARF = Internal number of file being archived
  1. ;DIARF0= Subfile List or DIAR/DIBT INDEX
  1. ;DIARI = SEARCH TEMPLATE USED
  1. ;DIARF1=Level # that search is on
  1. ;DIARP = Internal record no. of Filegram template
  1. ;DIARS = Temporary value / From value in DIP sort questions
  1. ;DIART = Temporary storage variable
  1. ;DIARU = Internal number of Select Criteria Template
  1. ;DIARST = Archival Activity upon entry to archival option