- 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 Feb 18, 2025@23:59:58 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