RTB2 ;MJK/TROY ISC;Help for Variable Pointer Fields; ; 5/27/87 1:44 PM ;
;;v 2.0;Record Tracking;;10/22/91
HELP S IOP="" D ^%ZIS K IOP W @IOF
;W !,"Enter a '"_$P(^DIC(195.1,RTA,0),"^")_"' record associated with one of the following:"
W !!?5,"Filename",?40,"Message",?50,"Prefix" K L S $P(L,"=",60)="" W !?5,L K L
F RTI=0:0 S RTI=$O(^DD(190,.01,"V","O",RTI)) Q:'RTI I $D(^DD(190,.01,"V",+$O(^(RTI,0)),0)) S Y=^(0) I $D(^DIC(195.1,RTA,"ENTITY","B",+Y)) D LIST
S T="TEXT" D HELPFF^RTB1 G Q:X="^" W ! S RTRD(1)="Yes^list entries in the file",RTRD(2)="No^do not list entries in the file",RTRD(0)="S",RTRD("B")=2
F RTI=0:0 S RTI=$O(^DD(190,.01,"V","O",RTI)) Q:'RTI S RTI1=+$O(^(RTI,0)) I $D(^DD(190,.01,"V",RTI1,0)) S RT0=^(0) I $D(^DIC(195.1,RTA,"ENTITY","B",+RT0)) D LIST1 G Q:X["^"
Q W ! K RT0,RTI1,V,S,RTRD,RTI S X="",Y=-1 Q
;
LIST W !?5,$P(^DIC(+Y,0),"^"),?40,$P(Y,"^",2),?50,$P(Y,"^",4) S $P(L,"-",60)="" W:$X'=0 ! W ?5,L K I,L Q
;
LIST1 S RTRD("A")="Do you want to list the '"_$P(RT0,"^",2)_"' entries? " D SET^RTRD Q:$E(X)'="Y"
K DIC S DIC(0)="IE",X="??",DIC=^DIC(+RT0,0,"GL") S:$D(^DD(190,.01,"V",RTI1,1)) DIC("S")=^(1) D ^DIC K DIC Q
;
TOP W !!,*7,"Press RETURN to continue or '^' to stop: " R X:DTIME S:'$T X="^" W:X'["^" @IOF Q
;
ENTITY G Q:'RTA G HELP S T="ENTHLP" D HELP^RTB1 I $D(RTDC(0)),RTDC(0)["M" S T="BOR" D HELP^RTB1
D ASK I X="^" S X="" G Q
I $E(X)="Y" S DIC(0)="IEQ",X="??",DIC="^RT(",DIC("S")=$S($D(RTDC("S")):RTDC("S"),1:"I $P(^(0),U,4)=RTA") D ^DIC K DIC
K RT D MORE G Q:$E(X)'="Y",HELP
;
MORE S RTRD(1)="Yes^display more help",RTRD(2)="No^do not display more help",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Do you want to see more 'help' information? " D SET^RTRD K RTRD Q
;
RTA S RTA=$S($D(^DIC(195.2,RTA,0)):$P(^(0),"^",3),1:"") Q
;
SPACE K RTHIT S Y=-1 I @("'$D(^"_$P(X,";",2)_+X_",0))") K X Q
F O=0:0 S O=$O(^DD(190,.01,"V","O",O)) Q:'O S Y1=+$O(^(O,0)) I $D(^DD(190,.01,"V",Y1,0)) S Y2=+^(0) I $E(^DIC(Y2,0,"GL"),2,99)=$P(X,";",2),$D(^DIC(195.1,+RTA,"ENTITY","B",Y2)) D SPACE1
S:'$D(RTHIT) RTHIT=0 I RTHIT S Y=X D NAME^RTB W " ",Y
S Y=$S('RTHIT:-1,1:+X) S:Y<0 X="" K RTHIT,Y1,S Q
;
SPACE1 S S=$S($D(^DD(190,.01,"V",Y1,1)):^(1),1:"I 1") I @("$D(^"_$P(X,";",2)_+X_",0))") S Y=+X X S S RTHIT=$T
Q
;
ASK S RTRD(1)="Yes^list existing entries",RTRD(2)="No^do not list entries",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Do you want to list existing entries? " D SET^RTRD K RTRD Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTB2 2449 printed Dec 13, 2024@02:33:27 Page 2
RTB2 ;MJK/TROY ISC;Help for Variable Pointer Fields; ; 5/27/87 1:44 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
HELP SET IOP=""
DO ^%ZIS
KILL IOP
WRITE @IOF
+1 ;W !,"Enter a '"_$P(^DIC(195.1,RTA,0),"^")_"' record associated with one of the following:"
+2 WRITE !!?5,"Filename",?40,"Message",?50,"Prefix"
KILL L
SET $PIECE(L,"=",60)=""
WRITE !?5,L
KILL L
+3 FOR RTI=0:0
SET RTI=$ORDER(^DD(190,.01,"V","O",RTI))
if 'RTI
QUIT
IF $DATA(^DD(190,.01,"V",+$ORDER(^(RTI,0)),0))
SET Y=^(0)
IF $DATA(^DIC(195.1,RTA,"ENTITY","B",+Y))
DO LIST
+4 SET T="TEXT"
DO HELPFF^RTB1
if X="^"
GOTO Q
WRITE !
SET RTRD(1)="Yes^list entries in the file"
SET RTRD(2)="No^do not list entries in the file"
SET RTRD(0)="S"
SET RTRD("B")=2
+5 FOR RTI=0:0
SET RTI=$ORDER(^DD(190,.01,"V","O",RTI))
if 'RTI
QUIT
SET RTI1=+$ORDER(^(RTI,0))
IF $DATA(^DD(190,.01,"V",RTI1,0))
SET RT0=^(0)
IF $DATA(^DIC(195.1,RTA,"ENTITY","B",+RT0))
DO LIST1
if X["^"
GOTO Q
Q WRITE !
KILL RT0,RTI1,V,S,RTRD,RTI
SET X=""
SET Y=-1
QUIT
+1 ;
LIST WRITE !?5,$PIECE(^DIC(+Y,0),"^"),?40,$PIECE(Y,"^",2),?50,$PIECE(Y,"^",4)
SET $PIECE(L,"-",60)=""
if $X'=0
WRITE !
WRITE ?5,L
KILL I,L
QUIT
+1 ;
LIST1 SET RTRD("A")="Do you want to list the '"_$PIECE(RT0,"^",2)_"' entries? "
DO SET^RTRD
if $EXTRACT(X)'="Y"
QUIT
+1 KILL DIC
SET DIC(0)="IE"
SET X="??"
SET DIC=^DIC(+RT0,0,"GL")
if $DATA(^DD(190,.01,"V",RTI1,1))
SET DIC("S")=^(1)
DO ^DIC
KILL DIC
QUIT
+2 ;
TOP WRITE !!,*7,"Press RETURN to continue or '^' to stop: "
READ X:DTIME
if '$TEST
SET X="^"
if X'["^"
WRITE @IOF
QUIT
+1 ;
ENTITY if 'RTA
GOTO Q
GOTO HELP
SET T="ENTHLP"
DO HELP^RTB1
IF $DATA(RTDC(0))
IF RTDC(0)["M"
SET T="BOR"
DO HELP^RTB1
+1 DO ASK
IF X="^"
SET X=""
GOTO Q
+2 IF $EXTRACT(X)="Y"
SET DIC(0)="IEQ"
SET X="??"
SET DIC="^RT("
SET DIC("S")=$SELECT($DATA(RTDC("S")):RTDC("S"),1:"I $P(^(0),U,4)=RTA")
DO ^DIC
KILL DIC
+3 KILL RT
DO MORE
if $EXTRACT(X)'="Y"
GOTO Q
GOTO HELP
+4 ;
MORE SET RTRD(1)="Yes^display more help"
SET RTRD(2)="No^do not display more help"
SET RTRD("B")=2
SET RTRD(0)="S"
SET RTRD("A")="Do you want to see more 'help' information? "
DO SET^RTRD
KILL RTRD
QUIT
+1 ;
RTA SET RTA=$SELECT($DATA(^DIC(195.2,RTA,0)):$PIECE(^(0),"^",3),1:"")
QUIT
+1 ;
SPACE KILL RTHIT
SET Y=-1
IF @("'$D(^"_$PIECE(X,";",2)_+X_",0))")
KILL X
QUIT
+1 FOR O=0:0
SET O=$ORDER(^DD(190,.01,"V","O",O))
if 'O
QUIT
SET Y1=+$ORDER(^(O,0))
IF $DATA(^DD(190,.01,"V",Y1,0))
SET Y2=+^(0)
IF $EXTRACT(^DIC(Y2,0,"GL"),2,99)=$PIECE(X,";",2)
IF $DATA(^DIC(195.1,+RTA,"ENTITY","B",Y2))
DO SPACE1
+2 if '$DATA(RTHIT)
SET RTHIT=0
IF RTHIT
SET Y=X
DO NAME^RTB
WRITE " ",Y
+3 SET Y=$SELECT('RTHIT:-1,1:+X)
if Y<0
SET X=""
KILL RTHIT,Y1,S
QUIT
+4 ;
SPACE1 SET S=$SELECT($DATA(^DD(190,.01,"V",Y1,1)):^(1),1:"I 1")
IF @("$D(^"_$PIECE(X,";",2)_+X_",0))")
SET Y=+X
XECUTE S
SET RTHIT=$TEST
+1 QUIT
+2 ;
ASK SET RTRD(1)="Yes^list existing entries"
SET RTRD(2)="No^do not list entries"
SET RTRD(0)="S"
SET RTRD("B")=2
SET RTRD("A")="Do you want to list existing entries? "
DO SET^RTRD
KILL RTRD
QUIT
