- XQH0 ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;12/08/2004 11:57
- ;;8.0;KERNEL;**372**;Jul 10, 1995;Build 5
- 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
- XQH0 ;LL/THM,SEA/AMF,JLI - HELP PROCESSOR ;12/08/2004 11:57
- +1 ;;8.0;KERNEL;**372**;Jul 10, 1995;Build 5
- 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
