- XQH ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;2/15/96 08:55 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XQH ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;2/15/96 08:55 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;8.0;KERNEL;**20**;Jul 10, 1995
- +3 IF $DATA(XQH)
- IF XQH=-1
- KILL XQH
- +4 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
