Routine: DITMU1

DITMU1 ;SFISC/EDE(OHPRD)-SETS DA ARRAY FROM D0,D1 ;

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ; This routine sets the DA array from D0,D1 etc. or D0,D1

 ; etc. from the DA array.  If the variable DITMU1=2 it sets

 ; the DA array, otherwise it sets D0,D1 etc.

 ; The variable DITMU1 will be killed upon exiting this routine.

 ; The entry point KILL kills D0, D1, etc.

START ;

 NEW I,J

 I $G(DITMU1)=2 D D0DA

 E  D DAD0

 K DITMU1

DAD0 ;

 F I=1:1 Q:'$D(DA(I))  S I(99-I)=DA(I)

 S J=0 F I=0:1 S J=$O(I(J)) Q:J'=+J  S @("D"_I)=I(J)

 S @("D"_I)=DA

D0DA ;

 F I=0:1 Q:'$D(@("D"_I))  S J=I

 F I=0:1 S DA(J)=@("D"_I) S J=J-1 Q:J<1

 S DA=@("D"_(I+1))

KILL ; EXTERNAL ENTRY POINT - KILL D0, D1, ETC.

 NEW I

 F I=0:1 Q:'$D(@("D"_I))  K @("D"_I)

DITMU1    ;SFISC/EDE(OHPRD)-SETS DA ARRAY FROM D0,D1 ;

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ; This routine sets the DA array from D0,D1 etc. or D0,D1

 +5       ; etc. from the DA array.  If the variable DITMU1=2 it sets

 +6       ; the DA array, otherwise it sets D0,D1 etc.

 +7       ;

 +8       ; The variable DITMU1 will be killed upon exiting this routine.

 +9       ;

 +10      ; The entry point KILL kills D0, D1, etc.

 +11      ;

START     ;

 +1        NEW I,J

 +2        IF $GET(DITMU1)=2

               DO D0DA

 +3       IF '$TEST

               DO DAD0

 +4        KILL DITMU1

 +5        QUIT

 +6       ;

DAD0      ;

 +1        FOR I=1:1

               IF '$DATA(DA(I))

                   QUIT

               SET I(99-I)=DA(I)

 +2        SET J=0

           FOR I=0:1

               SET J=$ORDER(I(J))

               IF J'=+J

                   QUIT

               SET @("D"_I)=I(J)

 +3        SET @("D"_I)=DA

 +4        QUIT

 +5       ;

D0DA      ;

 +1        FOR I=0:1

               IF '$DATA(@("D"_I))

                   QUIT

               SET J=I

 +2        FOR I=0:1

               SET DA(J)=@("D"_I)

               SET J=J-1

               IF J<1

                   QUIT

 +3        SET DA=@("D"_(I+1))

 +4        QUIT

 +5       ;

KILL      ; EXTERNAL ENTRY POINT - KILL D0, D1, ETC.

 +1        NEW I

 +2        FOR I=0:1

               IF '$DATA(@("D"_I))

                   QUIT

               KILL @("D"_I)

 +3        QUIT

DITMU1.m