- 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 Jan 18, 2025@03:06:56 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