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 ---[H[J[2J[HRTL 1334 printed Oct 16, 2024@18:34:40 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
