XQH5 ;SEA/AMF,JLI - HELP FRAME LISTER (CONTIN. XQH4) ;1/22/93 11:04 ; Apr 18, 2022@14:27:32
;;8.0;KERNEL;**770**;Jul 10, 1995;Build 4
;Per VHA Directive 2004-038, this routine should not be modified.
LIST ;
U IO
S XQHDR=$P(^TMP($J,"XQM","TOC",1),U,2),XQJ=^DIC(9.2,XQHDR,0),XQHDR=$P(XQJ,U,2) S:XQFMT=1 XQHDR=XQHDR_" ["_$P(XQJ,U,1)_"]"
S XQPG=0,XQPG(0)="" D HDR S (XQTB,XQTB(0))=0,XQJ=1 F XQI=1:1 Q:'$D(^TMP($J,"XQM","TOC",XQI))!XQUI D TOC
I 'XQUI F XQPG=1:1 Q:'$D(^TMP($J,"XQM","PG",XQPG)) S XQPG(0)="" D NWPG Q:XQUI S XQHY=^TMP($J,"XQM","PG",XQPG) D TEXT I XQFMT>-1 D:'XQUI KEYW ;p770 global reference
Q
TOC D:$Y+4>IOSL NWPG Q:XQUI S XQSTR=^TMP($J,"XQM","TOC",XQI) S XQK=+XQSTR-XQJ,X=+XQSTR-1 S:X<0 X=0 S:XQK<0 XQTB=XQTB(X) S:XQK>0 XQTB=XQTB+(X*2),XQTB(X)=XQTB
S XQJ=+XQSTR I XQK<0 F XQN=1:1:-XQK K XQJ(XQJ+XQN)
S XQJ(XQJ)=$S('$D(XQJ(XQJ)):1,1:XQJ(XQJ)+1) W ! F XQN=1:1:XQJ-1 W XQJ(XQN),"."
W $S(XQJ>0:XQJ(XQJ),1:" ")," " S XQII=$S($X<20:20,1:$X),XQN=^DIC(9.2,$P(XQSTR,U,2),0)
S XQIJ=$P(XQN,U,2),XQIL=IOM-6-XQII,XQIJ=$S($L(XQIJ)'>XQIL:XQIJ,1:$E(XQIJ,1,XQIL)) W:$X<20 ?20 W XQIJ," ",$E(XQDOT,1,XQIL-$L(XQIJ)),?(IOM-4),$J(^TMP($J,"XQM",$P(XQSTR,U,2)),3) W:XQFMT=1 !?XQII," [",$P(XQN,U,1),"]" W !
Q
TEXT ;
S XQI=^DIC(9.2,XQHY,0),XQI=$P(XQI,U,2)_$S((XQFMT>0):" ["_$P(XQI,U,1)_"]",1:"") W !?(80-$L(XQI)\2),XQI,!?(80-$L(XQI)\2),$E(XQDSH,1,$L(XQI)),!
S XQX=.002,XQPG(0)="a" F XQI=1:1 S XQX=$O(^DIC(9.2,XQHY,1,XQX)) Q:XQX="" D:($Y+4)>IOSL NWPG Q:XQUI W !,^DIC(9.2,XQHY,1,XQX,0) ;p770 global reference
W ! Q
KEYW ;
Q:'$D(^DIC(9.2,XQHY,2)) Q:'$P(^(2,0),U,3) S XQS=0
I $E(IOST,1)="C" S XQPG(0)="b" D NWPG Q:XQUI
W !!,$E(XQDSH,1,79),!
K XQKW S XQK=0 F XQJ=1:1 S XQK=$O(^DIC(9.2,XQHY,1,XQK)) Q:XQK="" S XQJ=^(XQK,0) F XQL=1:1 S XQKW=$P($P(XQJ,"]",XQL),"[",2) Q:'$L(XQKW) S XQKW(XQKW)=""
W !!,"KEYWORD",?34,"RELATED FRAME" W ?75,"PAGE",!,$E(XQDSH,1,7),?34,$E(XQDSH,1,13) W ?75,$E(XQDSH,1,4) W !
S XQJ=0 F XQK=1:1 S XQJ=$O(^DIC(9.2,XQHY,2,XQJ)) Q:XQJ'=+XQJ S XQL=^(XQJ,0) D KEYW1
S XQJ=0 F XQK=1:1 S XQJ=$O(XQKW(XQJ)) Q:XQJ'>0 W !,XQJ," **" S XQS=1
I XQS W !!?3,"* - KEYWORD MISSING FROM TEXT",!?3,"** - RELATED FRAME MISSING FROM LIST"
Q
KEYW1 S XQKW=$P(XQL,U,1),XQL=$P(XQL,U,2) W !,XQKW
W:'$D(XQKW(XQKW)) " *" S:'$D(XQKW(XQKW)) XQS=1 K XQKW(XQKW) I $L(XQL),$D(^DIC(9.2,XQL)) S XQK=^(XQL,0) W ?34,$P(XQK,U,2) W:XQFMT !?34,"[",$P(XQK,U,1),"]" W ?76,+^TMP($J,"XQM",XQL)
Q
NWPG ;
S:XQPG<1 XQPG=XQPG-1 I $E(IOST,1)="C" D CON S XQUI=(X="^") Q:XQUI
D HDR Q
CON ;
W !,"Press return to continue or '^' to escape " R X:DTIME S:'$T X=U
Q
HDR ;
W @IOF
S Y=$P($H,",",2)\60,Y=(Y#60/100+(Y\60)/100+DT) D DT^DIO2
W ?30,"HELP FRAME LISTING",?71 W $S(XQPG>0:"PAGE "_XQPG_XQPG(0),1:" "_$E(XQRN,-XQPG*4+1,-XQPG*4+4)) W !!?(80-$L(XQHDR)\2),XQHDR,!
I XQPG<1 W !?30,"TABLE OF CONTENTS",!?30,$E(XQDSH,1,17),!?75,"PAGE",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQH5 2883 printed Dec 13, 2024@02:05:45 Page 2
XQH5 ;SEA/AMF,JLI - HELP FRAME LISTER (CONTIN. XQH4) ;1/22/93 11:04 ; Apr 18, 2022@14:27:32
+1 ;;8.0;KERNEL;**770**;Jul 10, 1995;Build 4
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
LIST ;
+1 USE IO
+2 SET XQHDR=$PIECE(^TMP($JOB,"XQM","TOC",1),U,2)
SET XQJ=^DIC(9.2,XQHDR,0)
SET XQHDR=$PIECE(XQJ,U,2)
if XQFMT=1
SET XQHDR=XQHDR_" ["_$PIECE(XQJ,U,1)_"]"
+3 SET XQPG=0
SET XQPG(0)=""
DO HDR
SET (XQTB,XQTB(0))=0
SET XQJ=1
FOR XQI=1:1
if '$DATA(^TMP($JOB,"XQM","TOC",XQI))!XQUI
QUIT
DO TOC
+4 ;p770 global reference
IF 'XQUI
FOR XQPG=1:1
if '$DATA(^TMP($JOB,"XQM","PG",XQPG))
QUIT
SET XQPG(0)=""
DO NWPG
if XQUI
QUIT
SET XQHY=^TMP($JOB,"XQM","PG",XQPG)
DO TEXT
IF XQFMT>-1
if 'XQUI
DO KEYW
+5 QUIT
TOC if $Y+4>IOSL
DO NWPG
if XQUI
QUIT
SET XQSTR=^TMP($JOB,"XQM","TOC",XQI)
SET XQK=+XQSTR-XQJ
SET X=+XQSTR-1
if X<0
SET X=0
if XQK<0
SET XQTB=XQTB(X)
if XQK>0
SET XQTB=XQTB+(X*2)
SET XQTB(X)=XQTB
+1 SET XQJ=+XQSTR
IF XQK<0
FOR XQN=1:1:-XQK
KILL XQJ(XQJ+XQN)
+2 SET XQJ(XQJ)=$SELECT('$DATA(XQJ(XQJ)):1,1:XQJ(XQJ)+1)
WRITE !
FOR XQN=1:1:XQJ-1
WRITE XQJ(XQN),"."
+3 WRITE $SELECT(XQJ>0:XQJ(XQJ),1:" ")," "
SET XQII=$SELECT($X<20:20,1:$X)
SET XQN=^DIC(9.2,$PIECE(XQSTR,U,2),0)
+4 SET XQIJ=$PIECE(XQN,U,2)
SET XQIL=IOM-6-XQII
SET XQIJ=$SELECT($LENGTH(XQIJ)'>XQIL:XQIJ,1:$EXTRACT(XQIJ,1,XQIL))
if $X<20
WRITE ?20
WRITE XQIJ," ",$EXTRACT(XQDOT,1,XQIL-$LENGTH(XQIJ)),?(IOM-4),$JUSTIFY(^TMP($JOB,"XQM",$PIECE(XQSTR,U,2)),3)
if XQFMT=1
WRITE !?XQII," [",$PIECE(XQN,U,1),"]"
WRITE !
+5 QUIT
TEXT ;
+1 SET XQI=^DIC(9.2,XQHY,0)
SET XQI=$PIECE(XQI,U,2)_$SELECT((XQFMT>0):" ["_$PIECE(XQI,U,1)_"]",1:"")
WRITE !?(80-$LENGTH(XQI)\2),XQI,!?(80-$LENGTH(XQI)\2),$EXTRACT(XQDSH,1,$LENGTH(XQI)),!
+2 ;p770 global reference
SET XQX=.002
SET XQPG(0)="a"
FOR XQI=1:1
SET XQX=$ORDER(^DIC(9.2,XQHY,1,XQX))
if XQX=""
QUIT
if ($Y+4)>IOSL
DO NWPG
if XQUI
QUIT
WRITE !,^DIC(9.2,XQHY,1,XQX,0)
+3 WRITE !
QUIT
KEYW ;
+1 if '$DATA(^DIC(9.2,XQHY,2))
QUIT
if '$PIECE(^(2,0),U,3)
QUIT
SET XQS=0
+2 IF $EXTRACT(IOST,1)="C"
SET XQPG(0)="b"
DO NWPG
if XQUI
QUIT
+3 WRITE !!,$EXTRACT(XQDSH,1,79),!
+4 KILL XQKW
SET XQK=0
FOR XQJ=1:1
SET XQK=$ORDER(^DIC(9.2,XQHY,1,XQK))
if XQK=""
QUIT
SET XQJ=^(XQK,0)
FOR XQL=1:1
SET XQKW=$PIECE($PIECE(XQJ,"]",XQL),"[",2)
if '$LENGTH(XQKW)
QUIT
SET XQKW(XQKW)=""
+5 WRITE !!,"KEYWORD",?34,"RELATED FRAME"
WRITE ?75,"PAGE",!,$EXTRACT(XQDSH,1,7),?34,$EXTRACT(XQDSH,1,13)
WRITE ?75,$EXTRACT(XQDSH,1,4)
WRITE !
+6 SET XQJ=0
FOR XQK=1:1
SET XQJ=$ORDER(^DIC(9.2,XQHY,2,XQJ))
if XQJ'=+XQJ
QUIT
SET XQL=^(XQJ,0)
DO KEYW1
+7 SET XQJ=0
FOR XQK=1:1
SET XQJ=$ORDER(XQKW(XQJ))
if XQJ'>0
QUIT
WRITE !,XQJ," **"
SET XQS=1
+8 IF XQS
WRITE !!?3,"* - KEYWORD MISSING FROM TEXT",!?3,"** - RELATED FRAME MISSING FROM LIST"
+9 QUIT
KEYW1 SET XQKW=$PIECE(XQL,U,1)
SET XQL=$PIECE(XQL,U,2)
WRITE !,XQKW
+1 if '$DATA(XQKW(XQKW))
WRITE " *"
if '$DATA(XQKW(XQKW))
SET XQS=1
KILL XQKW(XQKW)
IF $LENGTH(XQL)
IF $DATA(^DIC(9.2,XQL))
SET XQK=^(XQL,0)
WRITE ?34,$PIECE(XQK,U,2)
if XQFMT
WRITE !?34,"[",$PIECE(XQK,U,1),"]"
WRITE ?76,+^TMP($JOB,"XQM",XQL)
+2 QUIT
NWPG ;
+1 if XQPG<1
SET XQPG=XQPG-1
IF $EXTRACT(IOST,1)="C"
DO CON
SET XQUI=(X="^")
if XQUI
QUIT
+2 DO HDR
QUIT
CON ;
+1 WRITE !,"Press return to continue or '^' to escape "
READ X:DTIME
if '$TEST
SET X=U
+2 QUIT
HDR ;
+1 WRITE @IOF
+2 SET Y=$PIECE($HOROLOG,",",2)\60
SET Y=(Y#60/100+(Y\60)/100+DT)
DO DT^DIO2
+3 WRITE ?30,"HELP FRAME LISTING",?71
WRITE $SELECT(XQPG>0:"PAGE "_XQPG_XQPG(0),1:" "_$EXTRACT(XQRN,-XQPG*4+1,-XQPG*4+4))
WRITE !!?(80-$LENGTH(XQHDR)\2),XQHDR,!
+4 IF XQPG<1
WRITE !?30,"TABLE OF CONTENTS",!?30,$EXTRACT(XQDSH,1,17),!?75,"PAGE",!
+5 QUIT
