source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ71.m@ 668

XQ71 ;SEA/AMF,MJM - Lookup response to menu prompt ;04/16/2002  13:47
 ;;8.0;KERNEL;**154,157**;Jul 10, 1995
CHK ;See if this option is locked, out of order, etc.
 S XQJMP=0,XQA=1,XQCY=XQY S:'$D(XQNOXUTL) XQCY0=XQY0 D ^XQCHK I XQCY<0 S XQY=-1
 Q
NO ;Space bar option no longer in the Option File
 K ^DISV(DUZ,"XQ",XQMN) S XQY=-1
 ;
OUT ;Exit point: return to XQ
 K %,%Y,%XQ,XQ,XQ2,XQA,XQA3,XQCY,XQCY0,XQI,XQII,XQIO,XQJ,XQK,XQMN,XQNOAV,XQNOXUTL,XQQ,XQS,XQSAV,XQW,XQX,XQZ
 Q
 ;
U I XQX'?.ANP S XQX="?" Q
 ;
UP S XQX=$$UP^XLFSTR(XQX) ;F XQZ=1:1 Q:XQX?.NUP  S XQW=$A(XQX,XQZ) I XQW<123,XQW>96 S XQX=$E(XQX,1,XQZ-1)_$C(XQW-32)_$E(XQX,XQZ+1,255)
 Q
 ;
XBLK F  S XQW=$E(XQK,1) Q:XQW'=" "  S XQK=$E(XQK,2,99)
 Q
 ;
DIC ;Entry point from XQ
 S XQNOAV=0,XQUR=$E(XQUR,1,27),XQMN=XQDIC,XQX=XQUR D U:XQX'?.PUN S XQUR=XQX
 I XQX=" ",$D(^DISV(DUZ,"XQ",XQMN)) S XQY=^(XQMN) G:'($D(^XUTL("XQO",XQDIC,U,XQY))&$D(^DIC(19,XQY,0))) NO S XQY0=^(0),XQNOXUTL="" D CHK W:$L($P(XQY,U,2)) !,$P(XQY,U,2) S XQY=+XQY I XQY>0 S XQUR="" G W
 I XQY=-1,$D(XQNOXUTL) K ^DISV(DUZ,"XQ",XQMN),XQNOXUTL S XQY=-2 G OUT
 I $E(XQDIC,1)="P" S XQDIC=$E(XQDIC,2,99) ;Remove the "P" this is not a jump
 ;I $S($D(^XUTL("XQO","P0")):1,'$D(^XUTL("XQO",XQDIC,0)):1,'$D(^DIC(19,$E(XQDIC,2,99),99.1)):1,1:0) D PMO^XQ8 S XQY=-2 G OUT
 I XQDIC=+XQDIC L +^XUTL("XQO",XQDIC):5 D:$S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET L -^XUTL("XQO",XQDIC)
 I $E(XQDIC,1)="U" D:$S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^VA(200,DUZ,203.1)):1,1:^VA(200,DUZ,203.1)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET
 S (XQ,XQS)=0 S:XQUR="0" XQUR="0"_$C(1) I XQUR="?" S X=0 G X
 S X=XQUR,XQA3=$S(($E(XQDIC,1)="P"):XQUR_U,1:XQUR) G:'$D(^XUTL("XQO",XQDIC,XQA3)) X S X=$E(XQUR,1,$L(XQUR)-1)_$C($A($E(XQUR,$L(XQUR)))-1)_"z" G:($P($O(^XUTL("XQO",XQDIC,XQA3)),U,1)=XQUR) X
 S XQSAV=X
 S %XQ=^XUTL("XQO",XQDIC,XQA3),XQY=+%XQ,XQY0=$P(^("^",XQY),U,2,99) D CHK S X=XQSAV W:$L($P(XQY,U,2)) "  ",$P(XQY0,U,2),$C(7),!,$P(XQY,U,2) S:$L($P(XQY,U,2)) XQNOAV=1 S:XQY<1 X=$O(^XUTL("XQO",XQDIC,X)) G X:XQY<1 I '$P(%XQ,U,2) W "  " S XQUR=""
 ;
W W $E($P(XQY0,U,2),$L(XQUR)+1,99) K XQ S:(XQMN=+XQMN) ^DISV(DUZ,"XQ",XQMN)=XQY G OUT
 ;
X S X=$O(^XUTL("XQO",XQDIC,X)) S XQJ=$S(X="":0,XQUR="?":X'=U,XQUR=("0"_$C(1)):'$L($P(X,"0",1)),1:'$L($P(X,XQUR,1)))
 I XQJ S XQY=^XUTL("XQO",XQDIC,X) S:'$P(XQY,U,2) XQ("S",+XQY)="" S XQY=+XQY G:$D(XQ("X",XQY)) X S XQY0=$P(^("^",XQY),U,2,99) S XQQ=X D CHK S X=XQQ G:XQY'>0 X S XQ=XQ+1,XQ(XQ)=+XQY_U_$P(XQY0,U,2)_U_XQA_U_$P(XQY,U,2),XQ("X",XQY)="" G:XQ>19 C G X
 S:'XQ XQY=-1 S:XQNOAV XQY=-2 Q:'XQ  I XQ=1,XQS=0 S XQY=+XQ(1) I XQY>0 S XQY0=$P(^XUTL("XQO",XQDIC,"^",XQY),U,2,99),XQA=$P(XQ(1),U,3) S:$D(XQ("S",XQY)) XQUR="" W:'$L(XQUR) "  " G W
 I XQ=1,XQS=0 W $E($P(XQ(1),U,2),$L(XQUR)+1,99),$C(7),!,$P(XQ(1),U,4) S XQY=-2 G OUT
 ;
C F XQY=1:1:XQ W !?4,XQS*20+XQY,?9,$P(XQ(XQY),U,2),?43,$P(XQ(XQY),U,4)
 W:XQ>19 !,"TYPE '^' TO STOP, OR" W !,"CHOOSE ",(XQS*20+1),"-",(XQS*20+XQY),": "
 R XQJ:DTIME S:'$T XQJ=U G:$L(XQJ)>7 C I XQJ?1.7N G C:'$D(XQ(XQJ-1#20+1)) W "  " S XQUR="",XQY=+XQ(XQJ-1#20+1) I XQY>0 S XQY0=$P(^XUTL("XQO",XQDIC,"^",XQY),U,2,99),XQA=$P(XQ(XQJ-1#20+1),U,3) G W
 I XQJ?1.7N W $C(7),$P(XQ(XQJ-1#20+1),U,4),! G C
 I $L(XQJ)>7 G C
 I '$L(XQJ),XQ>19 K XQ S XQS=XQS+1,XQ=0 G X
 S:XQJ=U XQJ="" K XQ S XQY=-1,XQUR=$C(95) S:$L(XQJ) XQUR=$S($E(XQDIC,1)="P":U_XQJ,1:XQJ),XQY=0 G OUT
 Q