XQH0 ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;12/08/2004 11:57
;;8.0;KERNEL;**372**;Jul 10, 1995;Build 3
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
REL D HDR^XQH1
REL1 W !!,?6,"RELATED HELP FRAME",?59,"KEYWORD",!?6,$E(XQDSH,1,18),?59,$E(XQDSH,1,7)
S (X,K)=0
F I=1:1 S X=$O(^DIC(9.2,XQHY,2,X)) Q:X'=+X S X1=^(X,0) S:'$L(X1) I=I-1 I $L(X1) S XQKY=$P(X1,U,1),X1=$P(X1,U,2),XQHX(I)=X1 D REL1W S K=K+1
W !!,"* - Recently viewed help frame"
BOT2 W !!,"Select HELP SYSTEM action or <return>: "
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 G GL3^XQH
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 REL S:"^Q"[X XQDONE=1 Q:XQDONE G:"^T"[X GL3^XQH D:"^O"[X HILITE^XQH2 D:"^H"[X HOW^XQH2 G:"^H"[X!("^O"[X) BOT2 I "^E"[$E(X,1,2)&XQAU D EDIT^XQH2 G BOT2
I X["?" S %XQI=2 D HELP^XQH2 G BOT2
I +X=X,$D(XQHX(+X)) S X=XQHX(X) W:'$L(X) !,"No help frame exists" G:'$L(X) BOT2 S XQHN=0,XQHS(X)="" D PSH S XQHY=X D INT^XQH Q:XQDONE D POP G GL3^XQH
S XQHX=X D CHK I Y<0 W " ??",*7 G BOT2
S X=$P(Y(0),U,2) W:'$L(X) !,"No help frame exists" G:'$L(X) BOT2 S XQHN=0,XQHS(X)="" D PSH S XQHY=X D INT^XQH Q:XQDONE D POP G GL3^XQH
Q
REL1W W !,$S('$L(X1):"",$D(XQHS(X1)):"*",1:""),?2,I,?6,$S('$L(X1):"[No help frame exists]",'$D(^DIC(9.2,X1,0)):"",1:$P(^DIC(9.2,X1,0),U,2)) W ?(54+(15-$L(XQKY)\2)),@IORV,XQKY,@IORVX Q
PSH S XQHR(XQHL,1)=XQHF,XQHR(XQHL,2)=XQHY,XQHR(XQHL,3)=XQHN,XQHL=XQHL+1 Q
POP S XQHL=XQHL-1,XQHF=XQHR(XQHL,1),XQHY=+XQHR(XQHL,2),XQHN=XQHR(XQHL,3) K XQHR(XQHL) Q
;
GET ;
S XQHSL=1 D INIT^XQH1 S DIC(0)="AEQMZL",DLAYGO=9.2,DIC="^DIC(9.2," D ^DIC S XQHY=Y K DLAYGO,DIC(0) I Y>0,$P(Y,U,3) S DA=+Y,DR="6////"_DUZ_";4///T",DIE=DIC D ^DIE
S:XQHY<0 XQH=-1 S Y=XQHY
Q
;
CHK S XQHX=$E(XQHX,1,30),XQHX2=$E(XQHX,1,$L(XQHX)-1)_$C($A($E(XQHX,$L(XQHX)))-1)_"z" F XQHJ=0:0 S XQHX2=$O(^DIC(9.2,XQHY,2,"B",XQHX2)) Q:$E(XQHX2,1,$L(XQHX))'=XQHX S XQHJ=XQHJ+1,XQHJ(XQHJ)=$O(^(XQHX2,0))_U_XQHX2
S:XQHJ=1 XQHI=1 I XQHJ'>0 W $C(7)," ??" S XQHI=0
CHKASK ;
I XQHJ>1 W ! F XQHI=1:1:XQHJ W !?5,$J(XQHI,3),". ",$P(XQHJ(XQHI),U,2)
I XQHJ>1 W !!?10,"Select from (1 to ",XQHJ,") : " R XQHI:DTIME S:'$T!(XQHI[U) XQDONE=1,XQHI=0 S:XQHI="" XQHI=0 I +XQHI'=XQHI!(XQHI<0)!(XQHI>XQHJ) W $C(7)," ??",! G CHKASK
S Y=$S(XQHI=0:-1,1:XQHJ(XQHI)) S:Y>0 Y(0)=^DIC(9.2,XQHY,2,+Y,0)
K XQHI,XQHJ,XQHX2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQH0 2850 printed Apr 09, 2024@21:14:31 Page 2
XQH0 ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;12/08/2004 11:57
+1 ;;8.0;KERNEL;**372**;Jul 10, 1995;Build 3
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
REL DO HDR^XQH1
REL1 WRITE !!,?6,"RELATED HELP FRAME",?59,"KEYWORD",!?6,$EXTRACT(XQDSH,1,18),?59,$EXTRACT(XQDSH,1,7)
+1 SET (X,K)=0
+2 FOR I=1:1
SET X=$ORDER(^DIC(9.2,XQHY,2,X))
if X'=+X
QUIT
SET X1=^(X,0)
if '$LENGTH(X1)
SET I=I-1
IF $LENGTH(X1)
SET XQKY=$PIECE(X1,U,1)
SET X1=$PIECE(X1,U,2)
SET XQHX(I)=X1
DO REL1W
SET K=K+1
+3 WRITE !!,"* - Recently viewed help frame"
BOT2 WRITE !!,"Select HELP SYSTEM action or <return>: "
+1 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
GOTO GL3^XQH
+2 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))
+3 IF $EXTRACT(X,1)="^"
if "^R"[X
GOTO REL
if "^Q"[X
SET XQDONE=1
if XQDONE
QUIT
if "^T"[X
GOTO GL3^XQH
if "^O"[X
DO HILITE^XQH2
if "^H"[X
DO HOW^XQH2
if "^H"[X!("^O"[X)
GOTO BOT2
IF "^E"[$EXTRACT(X,1,2)&XQAU
DO EDIT^XQH2
GOTO BOT2
+4 IF X["?"
SET %XQI=2
DO HELP^XQH2
GOTO BOT2
+5 IF +X=X
IF $DATA(XQHX(+X))
SET X=XQHX(X)
if '$LENGTH(X)
WRITE !,"No help frame exists"
if '$LENGTH(X)
GOTO BOT2
SET XQHN=0
SET XQHS(X)=""
DO PSH
SET XQHY=X
DO INT^XQH
if XQDONE
QUIT
DO POP
GOTO GL3^XQH
+6 SET XQHX=X
DO CHK
IF Y<0
WRITE " ??",*7
GOTO BOT2
+7 SET X=$PIECE(Y(0),U,2)
if '$LENGTH(X)
WRITE !,"No help frame exists"
if '$LENGTH(X)
GOTO BOT2
SET XQHN=0
SET XQHS(X)=""
DO PSH
SET XQHY=X
DO INT^XQH
if XQDONE
QUIT
DO POP
GOTO GL3^XQH
+8 QUIT
REL1W WRITE !,$SELECT('$LENGTH(X1):"",$DATA(XQHS(X1)):"*",1:""),?2,I,?6,$SELECT('$LENGTH(X1):"[No help frame exists]",'$DATA(^DIC(9.2,X1,0)):"",1:$PIECE(^DIC(9.2,X1,0),U,2))
WRITE ?(54+(15-$LENGTH(XQKY)\2)),@IORV,XQKY,@IORVX
QUIT
PSH SET XQHR(XQHL,1)=XQHF
SET XQHR(XQHL,2)=XQHY
SET XQHR(XQHL,3)=XQHN
SET XQHL=XQHL+1
QUIT
POP SET XQHL=XQHL-1
SET XQHF=XQHR(XQHL,1)
SET XQHY=+XQHR(XQHL,2)
SET XQHN=XQHR(XQHL,3)
KILL XQHR(XQHL)
QUIT
+1 ;
GET ;
+1 SET XQHSL=1
DO INIT^XQH1
SET DIC(0)="AEQMZL"
SET DLAYGO=9.2
SET DIC="^DIC(9.2,"
DO ^DIC
SET XQHY=Y
KILL DLAYGO,DIC(0)
IF Y>0
IF $PIECE(Y,U,3)
SET DA=+Y
SET DR="6////"_DUZ_";4///T"
SET DIE=DIC
DO ^DIE
+2 if XQHY<0
SET XQH=-1
SET Y=XQHY
+3 QUIT
+4 ;
CHK SET XQHX=$EXTRACT(XQHX,1,30)
SET XQHX2=$EXTRACT(XQHX,1,$LENGTH(XQHX)-1)_$CHAR($ASCII($EXTRACT(XQHX,$LENGTH(XQHX)))-1)_"z"
FOR XQHJ=0:0
SET XQHX2=$ORDER(^DIC(9.2,XQHY,2,"B",XQHX2))
if $EXTRACT(XQHX2,1,$LENGTH(XQHX))'=XQHX
QUIT
SET XQHJ=XQHJ+1
SET XQHJ(XQHJ)=$ORDER(^(XQHX2,0))_U_XQHX2
+1 if XQHJ=1
SET XQHI=1
IF XQHJ'>0
WRITE $CHAR(7)," ??"
SET XQHI=0
CHKASK ;
+1 IF XQHJ>1
WRITE !
FOR XQHI=1:1:XQHJ
WRITE !?5,$JUSTIFY(XQHI,3),". ",$PIECE(XQHJ(XQHI),U,2)
+2 IF XQHJ>1
WRITE !!?10,"Select from (1 to ",XQHJ,") : "
READ XQHI:DTIME
if '$TEST!(XQHI[U)
SET XQDONE=1
SET XQHI=0
if XQHI=""
SET XQHI=0
IF +XQHI'=XQHI!(XQHI<0)!(XQHI>XQHJ)
WRITE $CHAR(7)," ??",!
GOTO CHKASK
+3 SET Y=$SELECT(XQHI=0:-1,1:XQHJ(XQHI))
if Y>0
SET Y(0)=^DIC(9.2,XQHY,2,+Y,0)
+4 KILL XQHI,XQHJ,XQHX2
+5 QUIT
