RTL.m

RTL ;MJK/TROY ISC;Label Function Menu; ; 5/14/87  8:46 AM ;

 ;;v 2.0;Record Tracking;;10/22/91 

 D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X,";",1)_""","

 G:$D(^DOPT($P(X,";"),4)) A S ^DOPT($P(X,";"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y=""  S ^DOPT($P(X,";"),I,0)=$P(Y,";",3,99)

 D IXALL^DIK

A D OVERALL^RTPSET Q:$D(XQUIT)

 W !! S DIC="^DOPT("""_$P($T(+1),";")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0  D @+Y G A

 ;

1 ;;Label Formatter

 S IOP="" D ^%ZIS K IOP W:'$D(RTFMT) !!?5,">>> Label Formatter <<<" S DIC("DR")="3////"_+RTAPL,DIC("S")="I $P(^(0),U,3)=+RTAPL",DIC="^DIC(194.4,",DIC(0)="IAEMQL" W ! D ^DIC K DIC G Q1:Y<0

 S (RTFMT,DA)=+Y,DIE="^DIC(194.4,",DR="[RT LABEL EDIT]" D ^DIE I '$D(^DIC(194.4,RTFMT,0)) G Q1

 F I=0:0 S I=$O(^DIC(194.5,I)) Q:I'>0  I $D(^(I,0)) S @$P(^(0),"^",5)=$P(^(0),"^",4)

 W !!,"<<<<<<----------------------------Column No.------------------------------>>>>>>"

 W !!,"0--------1---------2---------3---------4---------5---------6---------7---------8"

 W !,"1        0         0         0         0         0         0         0         0",! S RTEST="",RTNUM=1,IOF="!" D PRT^RTL1 W !! G 1

Q1 F I=0:0 S I=$O(^DIC(194.5,I)) Q:I'>0  I $D(^(I,0)) K @$P(^(0),"^",5)

 K RTEST,RTNUM,I,DUOUT

 K %,%Y1,A,DO,D1,DA,DI,DIC,DIE,DQ,DR,J,K,POP,RTBC,RTFL,RTITLE,Y Q

2 ;;Test Label Format

 G TEST^RTL2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RTL   1334     printed  Apr 09, 2024@21:37:42                                                                                                                                                                                                         Page 2

RTL       ;MJK/TROY ISC;Label Function Menu; ; 5/14/87  8:46 AM ;

 +1       ;;v 2.0;Record Tracking;;10/22/91 

 +2        DO DT^DICRW

           SET X=$TEXT(+1)

           SET DIK="^DOPT("""_$PIECE(X,";",1)_""","

 +3        if $DATA(^DOPT($PIECE(X,";"),4))

               GOTO A

           SET ^DOPT($PIECE(X,";"),0)=$PIECE(X,";",3)_"^1N^"

           FOR I=1:1

               SET Y=$TEXT(@I)

               if Y=""

                   QUIT 

               SET ^DOPT($PIECE(X,";"),I,0)=$PIECE(Y,";",3,99)

 +4        DO IXALL^DIK

A          DO OVERALL^RTPSET

           if $DATA(XQUIT)

               QUIT 

 +1        WRITE !!

           SET DIC="^DOPT("""_$PIECE($TEXT(+1),";")_""","

           SET DIC(0)="IQEAM"

           DO ^DIC

           if Y<0

               QUIT 

           DO @+Y

           GOTO A

 +2       ;

1         ;;Label Formatter

 +1        SET IOP=""

           DO ^%ZIS

           KILL IOP

           if '$DATA(RTFMT)

               WRITE !!?5,">>> Label Formatter <<<"

           SET DIC("DR")="3////"_+RTAPL

           SET DIC("S")="I $P(^(0),U,3)=+RTAPL"

           SET DIC="^DIC(194.4,"

           SET DIC(0)="IAEMQL"

           WRITE !

           DO ^DIC

           KILL DIC

           if Y<0

               GOTO Q1

 +2        SET (RTFMT,DA)=+Y

           SET DIE="^DIC(194.4,"

           SET DR="[RT LABEL EDIT]"

           DO ^DIE

           IF '$DATA(^DIC(194.4,RTFMT,0))

               GOTO Q1

 +3        FOR I=0:0

               SET I=$ORDER(^DIC(194.5,I))

               if I'>0

                   QUIT 

               IF $DATA(^(I,0))

                   SET @$PIECE(^(0),"^",5)=$PIECE(^(0),"^",4)

 +4        WRITE !!,"<<<<<<----------------------------Column No.------------------------------>>>>>>"

 +5        WRITE !!,"0--------1---------2---------3---------4---------5---------6---------7---------8"

 +6        WRITE !,"1        0         0         0         0         0         0         0         0",!

           SET RTEST=""

           SET RTNUM=1

           SET IOF="!"

           DO PRT^RTL1

           WRITE !!

           GOTO 1

Q1         FOR I=0:0

               SET I=$ORDER(^DIC(194.5,I))

               if I'>0

                   QUIT 

               IF $DATA(^(I,0))

                   KILL @$PIECE(^(0),"^",5)

 +1        KILL RTEST,RTNUM,I,DUOUT

 +2        KILL %,%Y1,A,DO,D1,DA,DI,DIC,DIE,DQ,DR,J,K,POP,RTBC,RTFL,RTITLE,Y

           QUIT 

2         ;;Test Label Format

 +1        GOTO TEST^RTL2