- XQTOC ;SEA/MJM - Time Out/Continue/Jump Start ;01/10/13 13:42
- ;;8.0;KERNEL;**20,157,593,614**;Jul 10, 1995;Build 12
- ;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
- 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 12
- +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
