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 ---[H[J[2J[HDITMU1 1075 printed Nov 22, 2024@18:04:21 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
