DIT2.m

DIT2 ;SFISC/GFT-TRANSFER TEMPLATES ;10/16/90  9:37 AM

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

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

TEM F Z=0:0 W "." S Z=$O(^UTILITY("DITR",$J,DIK,Z)) Q:Z=""  F V=V:1 I $O(@(%Y_"0)"))="" D %XY S ^(0)=$P(@(%Y_"0)"),U,1,3)_U_DDT(0)_U_$P(^(0),U,5,99) K ^("ROU"),^("ROUOLD") K:DIK="^DIBT(" ^DIBT(V,1) Q

 Q

%XY ;

 S %Z=0,%A="",%C(-1)=0,%E=""

S S %B=-1

N S @("%B=$O("_%X_%A_"%B))") S:%B="" %B=-1 S %C(%Z)=%C(%Z-1),%D=$S($D(L(%B)):L(%B),1:%B)

 I %B=-1 Q:'%Z  S @("%B="_$P(%A,",",%Z+%C(%Z-2),%Z+%C(%Z-1))),%Z=%Z-1,%A=$P(%A,",",1,%Z+%C(%Z-1))_$E(",",%Z>0),%E=$P(%E,",",1,%Z+%C(%Z-1))_$E(",",%Z>0) G N

 I $D(@(%X_%A_"%B)"))#2 S W=^(%B) X A D Y^DIT1 X E S @(%Y_%E_"%D)=W") I %A="""DCL""," S ^(%B#1+DHIT_U_$P(%B,U,2))=^(%B) K ^(%B) G N

 I @("$D("_%X_%A_"%B))<9") G N

 S:+%B'=%B %B=""""_%B_"""" S:+%D'=%D %D=""""_%D_""""

 S %A=%A_%B_",",%Z=%Z+1,%E=%E_%D_"," G S

 ;

DCL ;S ^(%B#1+DHIT_U_$P(%B,U,2))=^(%B) K ^(%B) G N

 ;

DIT2      ;SFISC/GFT-TRANSFER TEMPLATES ;10/16/90  9:37 AM

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

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

TEM        FOR Z=0:0

               WRITE "."

               SET Z=$ORDER(^UTILITY("DITR",$JOB,DIK,Z))

               IF Z=""

                   QUIT 

               FOR V=V:1

                   IF $ORDER(@(%Y_"0)"))=""

                       DO %XY

                       SET ^(0)=$PIECE(@(%Y_"0)"),U,1,3)_U_DDT(0)_U_$PIECE(^(0),U,5,99)

                       KILL ^("ROU"),^("ROUOLD")

                       IF DIK="^DIBT("

                           KILL ^DIBT(V,1)

                       QUIT 

 +1        QUIT 

%XY       ;

 +1        SET %Z=0

           SET %A=""

           SET %C(-1)=0

           SET %E=""

S          SET %B=-1

N          SET @("%B=$O("_%X_%A_"%B))")

           IF %B=""

               SET %B=-1

           SET %C(%Z)=%C(%Z-1)

           SET %D=$SELECT($DATA(L(%B)):L(%B),1:%B)

 +1        IF %B=-1

               IF '%Z

                   QUIT 

               SET @("%B="_$PIECE(%A,",",%Z+%C(%Z-2),%Z+%C(%Z-1)))

               SET %Z=%Z-1

               SET %A=$PIECE(%A,",",1,%Z+%C(%Z-1))_$EXTRACT(",",%Z>0)

               SET %E=$PIECE(%E,",",1,%Z+%C(%Z-1))_$EXTRACT(",",%Z>0)

               GOTO N

 +2        IF $DATA(@(%X_%A_"%B)"))#2

               SET W=^(%B)

               XECUTE A

               DO Y^DIT1

               XECUTE E

               SET @(%Y_%E_"%D)=W")

               IF %A="""DCL"","

                   SET ^(%B#1+DHIT_U_$PIECE(%B,U,2))=^(%B)

                   KILL ^(%B)

                   GOTO N

 +3        IF @("$D("_%X_%A_"%B))<9")

               GOTO N

 +4        IF +%B'=%B

               SET %B=""""_%B_""""

           IF +%D'=%D

               SET %D=""""_%D_""""

 +5        SET %A=%A_%B_","

           SET %Z=%Z+1

           SET %E=%E_%D_","

           GOTO S

 +6       ;

DCL       ;S ^(%B#1+DHIT_U_$P(%B,U,2))=^(%B) K ^(%B) G N

 +1       ;