DITMU1.m

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

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

 ; 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DITMU1   1075     printed  Mar 13, 2025@21:59:16                                                                                                                                                                                                      Page 2

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

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

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

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

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

 +10      ;

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

 +12      ;

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

 +14      ;

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