XQTOC ;SEA/MJM - Time Out/Continue/Jump Start ;01/10/13 13:42
;;8.0;KERNEL;**20,157,593,614**;Jul 10, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
;
S ^XUTL("XQ",$J,1)=XQY_XQPSM_U_XQY0,^("T")=1
Q:XQJS=0
S %=^VA(200,DUZ,202.1) K ^(202.1) S $P(XQJS,U,2)=%,XQY=+%,XQPSM=$P(%,XQY,2,99),XQDIC=$S(XQPSM[",":$P(XQPSM,",",2),1:XQPSM)
I '$D(^XUTL("XQO",XQDIC,"^",XQY)) D NOGO Q
D
.N %
.S %=$G(^XUTL("XQO",XQDIC,"^",XQY))
.I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY))
.I %]"" S XQOPTN=$P(%,"^",1,99)
.E D NOGO S XQFAIL=""
.Q
I $D(XQFAIL) K XQFAIL Q
;
W !!,"You were last executing the '",$P(XQOPTN,U,3),"' menu option."
ASK W !,"Do you wish to resume" S %=1 D YN^DICN I '% W !!,"If you wish to continue at the last option you were executing, enter 'Y',",! G ASK
I %=1
E D NOGO Q
;
D
.N %
.S %=$G(^XUTL("XQO",XQDIC,"^",XQY))
.I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY))
.I %]"" S XQY0=$P(%,"^",2,99)
.E D NOGO S XQFAIL=""
.Q
I $D(XQFAIL) K XQFAIL Q
;
I $D(^XUTL("XQO",XQDIC,"^",XQY,0)) D
.S XQ=^(0)
.F XQI=1:1:XQ D
..N %
..S %=$G(^XUTL("XQO",XQDIC,"^",XQY,0,XQI))
..I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY,0,XQI))
..I %]"" S XQ(XQI)=%
..Q
.Q
E S XQ=0
Q
;
SET ;Set up variables to GO JUMP^XQ72. Enter from ASK1+1^XQ
S %=^XUTL("XQ",$J,1),XQSV=+%_U_+%_U_$P(%,U,2,99)
K XQJS
Q
;
LOOK ;Look up the Jump Start Entry
F Q:XQUR'[U S XQUR=$P(XQUR,U,2)
I '$L(XQUR) D NOGO Q
D S^XQ75 I 'XQY D NOGO Q
Q
;
NOGO ;Continue fails: reset to primary menu
S XQY=^XUTL("XQ",$J,"XQM"),XQA3="",XQA=0 K XQCON,XQRE,XQJS,XQUR,XQOPTN
D S1^XQCHK ; Reconstruct XQY0
S $P(^XUTL("XQ",$J,0),U,3)=$P(^(0),U,3)_", NOGO"
Q
;
;
CON ;Continue option logic. Enter from ASK^XQ on timeout.
W !!,"Do you want to halt and continue with this option later? YES// " R XQUR:20 S:(XQUR="")!('$T) XQUR="Y"
I "YyNn"'[$E(XQUR,1) W !!," If you enter 'Y' or 'RETURN' you will halt and continue here next time",!," you logon to the computer.",!," If you enter 'N' you will resume processing where you were." G CON
I "Nn"[$E(XQUR,1) W ! S XQUR=0,Y=^XUTL("XQ",$J,"T"),Y=^(Y),XQY0=$P(Y,U,2,99),XQPSM=$P(Y,U,1),(XQY,XQDIC)=+XQPSM,XQPSM=$P(XQPSM,XQY,2,3),XQAA="Select "_$P(XQY0,U,2)_$G(DUZ("TEST"))_" Option: " G ASK^XQ
S X=^XUTL("XQ",$J,^XUTL("XQ",$J,"T")),Y=^("XQM") I (+X'=+Y) S XQM="P"_+Y S XQPSM=$S($D(^XUTL("XQO",XQM,"^",+X)):XQM,$D(^XUTL("XQO","PXU","^",+X)):"PXU",1:"") D:XQPSM="" SS S:XQPSM'="" ^VA(200,DUZ,202.1)=+X_XQPSM
S X=$P($H,",",2),X=(X>41400&(X<46800))
W !!,$P("Great^OK^All right^Well certainly^Fine","^",$R(5)+1),". ",$P("See you later.^I'll be ready when you are.^Hurry back!^Have a nice lunch.","^",$R(3)+X+1)
G H^XUS
;
SS ;Search Secondaries for a particular option.
Q:'$D(^VA(200,DUZ,203,0)) Q:$P(^VA(200,DUZ,203,0),U,4)<1
S Y=0 F XQI=1:1 Q:XQPSM'="" S Y=$O(^VA(200,DUZ,203,Y)) Q:Y'>0 S %=+^(Y,0) I $D(^XUTL("XQO","P"_%,"^",+X)) S XQPSM="U"_DUZ_",P"_%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQTOC 3006 printed Sep 11, 2024@02:27 Page 2
XQTOC ;SEA/MJM - Time Out/Continue/Jump Start ;01/10/13 13:42
+1 ;;8.0;KERNEL;**20,157,593,614**;Jul 10, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 SET ^XUTL("XQ",$JOB,1)=XQY_XQPSM_U_XQY0
SET ^("T")=1
+5 if XQJS=0
QUIT
+6 SET %=^VA(200,DUZ,202.1)
KILL ^(202.1)
SET $PIECE(XQJS,U,2)=%
SET XQY=+%
SET XQPSM=$PIECE(%,XQY,2,99)
SET XQDIC=$SELECT(XQPSM[",":$PIECE(XQPSM,",",2),1:XQPSM)
+7 IF '$DATA(^XUTL("XQO",XQDIC,"^",XQY))
DO NOGO
QUIT
+8 Begin DoDot:1
+9 NEW %
+10 SET %=$GET(^XUTL("XQO",XQDIC,"^",XQY))
+11 IF %=""
SET %=$GET(^DIC(19,"AXQ",XQDIC,"^",XQY))
+12 IF %]""
SET XQOPTN=$PIECE(%,"^",1,99)
+13 IF '$TEST
DO NOGO
SET XQFAIL=""
+14 QUIT
End DoDot:1
+15 IF $DATA(XQFAIL)
KILL XQFAIL
QUIT
+16 ;
+17 WRITE !!,"You were last executing the '",$PIECE(XQOPTN,U,3),"' menu option."
ASK WRITE !,"Do you wish to resume"
SET %=1
DO YN^DICN
IF '%
WRITE !!,"If you wish to continue at the last option you were executing, enter 'Y',",!
GOTO ASK
+1 IF %=1
+2 IF '$TEST
DO NOGO
QUIT
+3 ;
+4 Begin DoDot:1
+5 NEW %
+6 SET %=$GET(^XUTL("XQO",XQDIC,"^",XQY))
+7 IF %=""
SET %=$GET(^DIC(19,"AXQ",XQDIC,"^",XQY))
+8 IF %]""
SET XQY0=$PIECE(%,"^",2,99)
+9 IF '$TEST
DO NOGO
SET XQFAIL=""
+10 QUIT
End DoDot:1
+11 IF $DATA(XQFAIL)
KILL XQFAIL
QUIT
+12 ;
+13 IF $DATA(^XUTL("XQO",XQDIC,"^",XQY,0))
Begin DoDot:1
+14 SET XQ=^(0)
+15 FOR XQI=1:1:XQ
Begin DoDot:2
+16 NEW %
+17 SET %=$GET(^XUTL("XQO",XQDIC,"^",XQY,0,XQI))
+18 IF %=""
SET %=$GET(^DIC(19,"AXQ",XQDIC,"^",XQY,0,XQI))
+19 IF %]""
SET XQ(XQI)=%
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF '$TEST
SET XQ=0
+23 QUIT
+24 ;
SET ;Set up variables to GO JUMP^XQ72. Enter from ASK1+1^XQ
+1 SET %=^XUTL("XQ",$JOB,1)
SET XQSV=+%_U_+%_U_$PIECE(%,U,2,99)
+2 KILL XQJS
+3 QUIT
+4 ;
LOOK ;Look up the Jump Start Entry
+1 FOR
if XQUR'[U
QUIT
SET XQUR=$PIECE(XQUR,U,2)
+2 IF '$LENGTH(XQUR)
DO NOGO
QUIT
+3 DO S^XQ75
IF 'XQY
DO NOGO
QUIT
+4 QUIT
+5 ;
NOGO ;Continue fails: reset to primary menu
+1 SET XQY=^XUTL("XQ",$JOB,"XQM")
SET XQA3=""
SET XQA=0
KILL XQCON,XQRE,XQJS,XQUR,XQOPTN
+2 ; Reconstruct XQY0
DO S1^XQCHK
+3 SET $PIECE(^XUTL("XQ",$JOB,0),U,3)=$PIECE(^(0),U,3)_", NOGO"
+4 QUIT
+5 ;
+6 ;
CON ;Continue option logic. Enter from ASK^XQ on timeout.
+1 WRITE !!,"Do you want to halt and continue with this option later? YES// "
READ XQUR:20
if (XQUR="")!('$TEST)
SET XQUR="Y"
+2 IF "YyNn"'[$EXTRACT(XQUR,1)
WRITE !!," If you enter 'Y' or 'RETURN' you will halt and continue here next time",!," you logon to the computer.",!," If you enter 'N' you will resume processing where you were."
GOTO CON
+3 IF "Nn"[$EXTRACT(XQUR,1)
WRITE !
SET XQUR=0
SET Y=^XUTL("XQ",$JOB,"T")
SET Y=^(Y)
SET XQY0=$PIECE(Y,U,2,99)
SET XQPSM=$PIECE(Y,U,1)
SET (XQY,XQDIC)=+XQPSM
SET XQPSM=$PIECE(XQPSM,XQY,2,3)
SET XQAA="Select "_$PIECE(XQY0,U,2)_$GET(DUZ("TEST"))_" Option: "
GOTO ASK^XQ
+4 SET X=^XUTL("XQ",$JOB,^XUTL("XQ",$JOB,"T"))
SET Y=^("XQM")
IF (+X'=+Y)
SET XQM="P"_+Y
SET XQPSM=$SELECT($DATA(^XUTL("XQO",XQM,"^",+X)):XQM,$DATA(^XUTL("XQO","PXU","^",+X)):"PXU",1:"")
if XQPSM=""
DO SS
if XQPSM'=""
SET ^VA(200,DUZ,202.1)=+X_XQPSM
+5 SET X=$PIECE($HOROLOG,",",2)
SET X=(X>41400&(X<46800))
+6 WRITE !!,$PIECE("Great^OK^All right^Well certainly^Fine","^",$RANDOM(5)+1),". ",$PIECE("See you later.^I'll be ready when you are.^Hurry back!^Have a nice lunch.","^",$RANDOM(3)+X+1)
+7 GOTO H^XUS
+8 ;
SS ;Search Secondaries for a particular option.
+1 if '$DATA(^VA(200,DUZ,203,0))
QUIT
if $PIECE(^VA(200,DUZ,203,0),U,4)<1
QUIT
+2 SET Y=0
FOR XQI=1:1
if XQPSM'=""
QUIT
SET Y=$ORDER(^VA(200,DUZ,203,Y))
if Y'>0
QUIT
SET %=+^(Y,0)
IF $DATA(^XUTL("XQO","P"_%,"^",+X))
SET XQPSM="U"_DUZ_",P"_%
+3 QUIT
