DITMU1.m

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

 Q

 ;

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

 Q

 ;

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))

 Q

 ;

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

 NEW I

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

 Q

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