File:  [Coherent Logic Development] / freem_fileman / USER / DITMU1.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DITMU1	;SFISC/EDE(OHPRD)-SETS DA ARRAY FROM D0,D1 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: 	; This routine sets the DA array from D0,D1 etc. or D0,D1
    6: 	; etc. from the DA array.  If the variable DITMU1=2 it sets
    7: 	; the DA array, otherwise it sets D0,D1 etc.
    8: 	;
    9: 	; The variable DITMU1 will be killed upon exiting this routine.
   10: 	;
   11: 	; The entry point KILL kills D0, D1, etc.
   12: 	;
   13: START	;
   14: 	NEW I,J
   15: 	I $G(DITMU1)=2 D D0DA
   16: 	E  D DAD0
   17: 	K DITMU1
   18: 	Q
   19: 	;
   20: DAD0	;
   21: 	F I=1:1 Q:'$D(DA(I))  S I(99-I)=DA(I)
   22: 	S J=0 F I=0:1 S J=$O(I(J)) Q:J'=+J  S @("D"_I)=I(J)
   23: 	S @("D"_I)=DA
   24: 	Q
   25: 	;
   26: D0DA	;
   27: 	F I=0:1 Q:'$D(@("D"_I))  S J=I
   28: 	F I=0:1 S DA(J)=@("D"_I) S J=J-1 Q:J<1
   29: 	S DA=@("D"_(I+1))
   30: 	Q
   31: 	;
   32: KILL	; EXTERNAL ENTRY POINT - KILL D0, D1, ETC.
   33: 	NEW I
   34: 	F I=0:1 Q:'$D(@("D"_I))  K @("D"_I)
   35: 	Q

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