DDSR1.m

DDSR1 ;SFISC/MKO-PAINT ;08:09 AM  20 May 1994

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

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

 ;

CAP ;Write captions in "X" nodes

 W:$D(DDGLVAN) $P(DDGLVID,DDGLDEL,2)

 ;

 S DY=""

 F  S DY=$O(@DDSREFS@("X",DDS3P,DY)) Q:DY=""  S DX=$O(^(DY,"")),DDS3CAP=^(DX) D:$D(^(DX))=11  X IOXY W DDS3CAP

 . N A,C,C1,C2,P,PC,V,X

 . Q:'$D(@DDSREFS@("X",DDS3P,DY,DX,"A"))  S A=^("A")

 . S X=DDS3CAP,DDS3CAP="",P=1

 . F PC=1:1:$L(A,U) S C=$P(A,U,PC) D:C]""

 .. S C1=$P(C,";"),C2=$P(C,";",2)

 .. S V=$S($P(C,";",3)="U":$P(DDGLVID,DDGLDEL,4),1:"")

 .. S DDS3CAP=DDS3CAP_$E(X,P,C1-1)_V_$E(X,C1,C2)_$P(DDGLVID,DDGLDEL,10)_$S($D(DDGLVAN):$P(DDGLVID,DDGLDEL,2),1:"")

 .. S P=C2+1

 . S DDS3CAP=DDS3CAP_$E(X,P,999)

 ;

 W:$D(DDGLVAN) $P(DDGLVID,DDGLDEL,10)

 K DDS3CAP

 Q

DDSR1     ;SFISC/MKO-PAINT ;08:09 AM  20 May 1994

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

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

 +3       ;

CAP       ;Write captions in "X" nodes

 +1        IF $DATA(DDGLVAN)

               WRITE $PIECE(DDGLVID,DDGLDEL,2)

 +2       ;

 +3        SET DY=""

 +4        FOR 

               SET DY=$ORDER(@DDSREFS@("X",DDS3P,DY))

               IF DY=""

                   QUIT 

               SET DX=$ORDER(^(DY,""))

               SET DDS3CAP=^(DX)

               IF $DATA(^(DX))=11

                   Begin DoDot:1

 +5                    NEW A,C,C1,C2,P,PC,V,X

 +6                    IF '$DATA(@DDSREFS@("X",DDS3P,DY,DX,"A"))

                           QUIT 

                       SET A=^("A")

 +7                    SET X=DDS3CAP

                       SET DDS3CAP=""

                       SET P=1

 +8                    FOR PC=1:1:$LENGTH(A,U)

                           SET C=$PIECE(A,U,PC)

                           IF C]""

                               Begin DoDot:2

 +9                                SET C1=$PIECE(C,";")

                                   SET C2=$PIECE(C,";",2)

 +10                               SET V=$SELECT($PIECE(C,";",3)="U":$PIECE(DDGLVID,DDGLDEL,4),1:"")

 +11                               SET DDS3CAP=DDS3CAP_$EXTRACT(X,P,C1-1)_V_$EXTRACT(X,C1,C2)_$PIECE(DDGLVID,DDGLDEL,10)_$SELECT($DATA(DDGLVAN):$PIECE(DDGLVID,DDGLDEL,2),1:"")

 +12                               SET P=C2+1

                               End DoDot:2

 +13                   SET DDS3CAP=DDS3CAP_$EXTRACT(X,P,999)

                   End DoDot:1

               XECUTE IOXY

               WRITE DDS3CAP

 +14      ;

 +15       IF $DATA(DDGLVAN)

               WRITE $PIECE(DDGLVID,DDGLDEL,10)

 +16       KILL DDS3CAP

 +17       QUIT