XQH ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;2/15/96 08:55
;;8.0;KERNEL;**20**;Jul 10, 1995
I $D(XQH),XQH=-1 K XQH
I $D(XQH),XQH'="" G EN
LP D GET^XQH0 D:Y>0 EACH G:XQHY>0 LP D OUT^XQH1 Q
ENL D GET^XQH0 D:XQHY>0 EACH D OUT^XQH1 Q
EN1 S XQHSL=0 S DIR(0)="E" D ^DIR Q:$D(DIRUT)
EN S XQHSL=1 D START K XQH Q
START N DA,DIC,DIE,DR,D,DIFLD,DP,DQ,DU,DZ,DO,X,Y ;Don't step on FM
D INIT^XQH1 I XQH=+XQH S:'$D(^DIC(9.2,XQH,0)) XQH=-1 S XQHY=XQH D:XQHY>0 EACH D OUT^XQH1 Q
S X=XQH,Y=-1 S:$D(^DIC(9.2,"B",X)) Y=$O(^(X,0)) I Y'>0 S X=$O(^DIC(9.2,"B",X)) I $E(X,1,$L(XQH))=XQH,$E($O(^(X)),1,$L(XQH))'=XQH S Y=$O(^(X,0))
S XQHY=Y S:Y'>0 XQH=-1 D:XQHY>0 EACH D OUT^XQH1 Q
;
EACH S (XQHL,XQHN)=0 K XQHS,XQHR,XQHX
INT Q:'$D(^DIC(9.2,+XQHY,0)) S XQHY(0)=^(0),XQHY=XQHY_"^"_$P(XQHY(0),U,1) D:'$D(IOF) HOME^%ZIS W @IOF
S XQAU=$S($D(^XUSEC("XUAUTHOR",DUZ)):1,$P(^DIC(9.2,+XQHY,0),U,4)=DUZ:1,1:$D(^DIC(9.2,+XQHY,4,"AB",DUZ)))
S:'$D(X) X="" S XQHF=$P(XQHY(0),U,2),XQHS(+XQHY)="",XQHX=X,X=$O(^DIC(9.2,+XQHY,1,0))
GL3 D:XQHSL HDR^XQH1 W:'XQHSL ! S XQH2=.002
S XQHY=+XQHY,XQDONE=""
S XQHON=0 F XQH1=1:1 S XQH2=$O(^DIC(9.2,XQHY,1,XQH2)) Q:XQH2="" D:$Y+3>IOSL WAIT^XQH1 Q:XQDONE S X1=^DIC(9.2,XQHY,1,XQH2,0) W ! D G4
K XQHON,XQHNXT,XQHTXT Q:XQDONE S XQBL=1 I $D(^DIC(9.2,XQHY,2)) S XQBL='$P(^(2,0),U,4)
S XQ3=0 I 'XQHSL S XQ3=XQBL I XQBL S XQ3=(I>15)+1
I 'XQBL G:$Y<(IOSL-7-($P(^DIC(9.2,XQHY,2,0),U,3))) REL1^XQH0
BOT1 Q:(XQ3=1) I XQ3=2 W !!,"Press RETURN to continue. " R X:DTIME Q
W !!,"Select HELP SYSTEM action or <return>: "
S X=IOM X ^%ZOSF("RM") R X:DTIME X:$D(^DIC(9.2,+XQHY,10.2)) ^(10.2) I '$T!'$L(X) S:'XQHL XQDONE=1 Q:XQDONE D POP^XQH0 G INT
S:X="^" X="^Q" S %XQK=X,X="" F %XQJ=1:1:$L(%XQK) S X=X_$S(($E(%XQK,%XQJ)?1L):$C($A($E(%XQK,%XQJ))-32),1:$E(%XQK,%XQJ))
I $E(X,1)="^" G:"^R"[X GL3 S:"^Q"[X XQDONE=1 Q:XQDONE G:"^T"[X&'XQBL REL^XQH0 D:"^O"[X HILITE^XQH2 D:"^H"[X HOW^XQH2 G:"^O"[X!("^H"[X) BOT1 I "^E"[$E(X,1,2)&XQAU D EDIT^XQH2 G BOT1
I X["?" S %XQI=1 D HELP^XQH2 G BOT1
I XQBL W " ??",*7 G BOT1
S XQHX=X D CHK^XQH0 I Y<0 W " ??",*7 G BOT1
S X=$P(Y(0),U,2) W:'$L(X) !,"No help frame exists" G:'$L(X) BOT1 S XQHN=0,XQHS(X)="" D PSH^XQH0 S XQHY=X D INT Q:XQDONE D POP^XQH0 G GL3
G4 ;
I XQHON W @IORV
G4A I XQHON W:X1="" @IORVX Q:X1="" S XQHTXT=$P(X1,"]"),X1=$P(X1,"]",2,99),XQHNXT=$E(X1) S:XQHNXT="]" XQHTXT=XQHTXT_"]",X1=$E(X1,2,200) W XQHTXT G:XQHNXT="]" G4A W @IORVX S XQHON=0 G G4A
Q:X1="" S XQHTXT=$P(X1,"["),X1=$P(X1,"[",2,99),XQHNXT=$E(X1) S:XQHNXT="[" XQHTXT=XQHTXT_"[",X1=$E(X1,2,200) I XQHTXT["]" S XQHTXT=$P(XQHTXT,"]")_$P(XQHTXT,"]",2,99)
W XQHTXT G:XQHNXT="["!(XQHNXT="") G4A W @IORV S XQHON=1 G G4A
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQH 2676 printed Oct 16, 2024@18:06:28 Page 2
XQH ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;2/15/96 08:55
+1 ;;8.0;KERNEL;**20**;Jul 10, 1995
+2 IF $DATA(XQH)
IF XQH=-1
KILL XQH
+3 IF $DATA(XQH)
IF XQH'=""
GOTO EN
LP DO GET^XQH0
if Y>0
DO EACH
if XQHY>0
GOTO LP
DO OUT^XQH1
QUIT
ENL DO GET^XQH0
if XQHY>0
DO EACH
DO OUT^XQH1
QUIT
EN1 SET XQHSL=0
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
QUIT
EN SET XQHSL=1
DO START
KILL XQH
QUIT
START ;Don't step on FM
NEW DA,DIC,DIE,DR,D,DIFLD,DP,DQ,DU,DZ,DO,X,Y
+1 DO INIT^XQH1
IF XQH=+XQH
if '$DATA(^DIC(9.2,XQH,0))
SET XQH=-1
SET XQHY=XQH
if XQHY>0
DO EACH
DO OUT^XQH1
QUIT
+2 SET X=XQH
SET Y=-1
if $DATA(^DIC(9.2,"B",X))
SET Y=$ORDER(^(X,0))
IF Y'>0
SET X=$ORDER(^DIC(9.2,"B",X))
IF $EXTRACT(X,1,$LENGTH(XQH))=XQH
IF $EXTRACT($ORDER(^(X)),1,$LENGTH(XQH))'=XQH
SET Y=$ORDER(^(X,0))
+3 SET XQHY=Y
if Y'>0
SET XQH=-1
if XQHY>0
DO EACH
DO OUT^XQH1
QUIT
+4 ;
EACH SET (XQHL,XQHN)=0
KILL XQHS,XQHR,XQHX
INT if '$DATA(^DIC(9.2,+XQHY,0))
QUIT
SET XQHY(0)=^(0)
SET XQHY=XQHY_"^"_$PIECE(XQHY(0),U,1)
if '$DATA(IOF)
DO HOME^%ZIS
WRITE @IOF
+1 SET XQAU=$SELECT($DATA(^XUSEC("XUAUTHOR",DUZ)):1,$PIECE(^DIC(9.2,+XQHY,0),U,4)=DUZ:1,1:$DATA(^DIC(9.2,+XQHY,4,"AB",DUZ)))
+2 if '$DATA(X)
SET X=""
SET XQHF=$PIECE(XQHY(0),U,2)
SET XQHS(+XQHY)=""
SET XQHX=X
SET X=$ORDER(^DIC(9.2,+XQHY,1,0))
GL3 if XQHSL
DO HDR^XQH1
if 'XQHSL
WRITE !
SET XQH2=.002
+1 SET XQHY=+XQHY
SET XQDONE=""
+2 SET XQHON=0
FOR XQH1=1:1
SET XQH2=$ORDER(^DIC(9.2,XQHY,1,XQH2))
if XQH2=""
QUIT
if $Y+3>IOSL
DO WAIT^XQH1
if XQDONE
QUIT
SET X1=^DIC(9.2,XQHY,1,XQH2,0)
WRITE !
DO G4
+3 KILL XQHON,XQHNXT,XQHTXT
if XQDONE
QUIT
SET XQBL=1
IF $DATA(^DIC(9.2,XQHY,2))
SET XQBL='$PIECE(^(2,0),U,4)
+4 SET XQ3=0
IF 'XQHSL
SET XQ3=XQBL
IF XQBL
SET XQ3=(I>15)+1
+5 IF 'XQBL
if $Y<(IOSL-7-($PIECE(^DIC(9.2,XQHY,2,0),U,3)))
GOTO REL1^XQH0
BOT1 if (XQ3=1)
QUIT
IF XQ3=2
WRITE !!,"Press RETURN to continue. "
READ X:DTIME
QUIT
+1 WRITE !!,"Select HELP SYSTEM action or <return>: "
+2 SET X=IOM
XECUTE ^%ZOSF("RM")
READ X:DTIME
if $DATA(^DIC(9.2,+XQHY,10.2))
XECUTE ^(10.2)
IF '$TEST!'$LENGTH(X)
if 'XQHL
SET XQDONE=1
if XQDONE
QUIT
DO POP^XQH0
GOTO INT
+3 if X="^"
SET X="^Q"
SET %XQK=X
SET X=""
FOR %XQJ=1:1:$LENGTH(%XQK)
SET X=X_$SELECT(($EXTRACT(%XQK,%XQJ)?1L):$CHAR($ASCII($EXTRACT(%XQK,%XQJ))-32),1:$EXTRACT(%XQK,%XQJ))
+4 IF $EXTRACT(X,1)="^"
if "^R"[X
GOTO GL3
if "^Q"[X
SET XQDONE=1
if XQDONE
QUIT
if "^T"[X&'XQBL
GOTO REL^XQH0
if "^O"[X
DO HILITE^XQH2
if "^H"[X
DO HOW^XQH2
if "^O"[X!("^H"[X)
GOTO BOT1
IF "^E"[$EXTRACT(X,1,2)&XQAU
DO EDIT^XQH2
GOTO BOT1
+5 IF X["?"
SET %XQI=1
DO HELP^XQH2
GOTO BOT1
+6 IF XQBL
WRITE " ??",*7
GOTO BOT1
+7 SET XQHX=X
DO CHK^XQH0
IF Y<0
WRITE " ??",*7
GOTO BOT1
+8 SET X=$PIECE(Y(0),U,2)
if '$LENGTH(X)
WRITE !,"No help frame exists"
if '$LENGTH(X)
GOTO BOT1
SET XQHN=0
SET XQHS(X)=""
DO PSH^XQH0
SET XQHY=X
DO INT
if XQDONE
QUIT
DO POP^XQH0
GOTO GL3
G4 ;
+1 IF XQHON
WRITE @IORV
G4A IF XQHON
if X1=""
WRITE @IORVX
if X1=""
QUIT
SET XQHTXT=$PIECE(X1,"]")
SET X1=$PIECE(X1,"]",2,99)
SET XQHNXT=$EXTRACT(X1)
if XQHNXT="]"
SET XQHTXT=XQHTXT_"]"
SET X1=$EXTRACT(X1,2,200)
WRITE XQHTXT
if XQHNXT="]"
GOTO G4A
WRITE @IORVX
SET XQHON=0
GOTO G4A
+1 if X1=""
QUIT
SET XQHTXT=$PIECE(X1,"[")
SET X1=$PIECE(X1,"[",2,99)
SET XQHNXT=$EXTRACT(X1)
if XQHNXT="["
SET XQHTXT=XQHTXT_"["
SET X1=$EXTRACT(X1,2,200)
IF XQHTXT["]"
SET XQHTXT=$PIECE(XQHTXT,"]")_$PIECE(XQHTXT,"]",2,99)
+2 WRITE XQHTXT
if XQHNXT="["!(XQHNXT="")
GOTO G4A
WRITE @IORV
SET XQHON=1
GOTO G4A
+3 QUIT
