XBDAD0.m

XBDAD0 ; IHS/ADC/GTH - SET ALTERNATE DA/D0 ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

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

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

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

 ;

 ; The variable XBDAD0 will be killed upon exiting this

 ; routine.

 ;

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

 ;

START ;

 NEW I,J

 I $G(XBDAD0)=2 D D0DA I 1

 E  D DAD0

 KILL XBDAD0

 Q

 ;

DAD0 ; -----  Set D0 (etc) from DA array.

 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 ; ----- Set DA array from D0 (etc).

 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 ;PEP - KILL D0, D1, ETC.

 NEW I

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

 Q

 ;

XBDAD0    ; IHS/ADC/GTH - SET ALTERNATE DA/D0 ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

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

 +4       ; etc. from the DA array.  If the variable XBDAD0=2 it sets

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

 +6       ;

 +7       ; The variable XBDAD0 will be killed upon exiting this

 +8       ; routine.

 +9       ;

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

 +11      ;

START     ;

 +1        NEW I,J

 +2        IF $GET(XBDAD0)=2

               DO D0DA

               IF 1

 +3       IF '$TEST

               DO DAD0

 +4        KILL XBDAD0

 +5        QUIT 

 +6       ;

DAD0      ; -----  Set D0 (etc) from DA array.

 +1        FOR I=1:1

               IF '$DATA(DA(I))

                   QUIT 

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

 +2        SET J=0

 +3        FOR I=0:1

               SET J=$ORDER(I(J))

               IF J'=+J

                   QUIT 

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

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

 +5        QUIT 

 +6       ;

D0DA      ; ----- Set DA array from D0 (etc).

 +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      ;PEP - KILL D0, D1, ETC.

 +1        NEW I

 +2        FOR I=0:1

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

                   QUIT 

               KILL @("D"_I)

 +3        QUIT 

 +4       ;