source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQTOC.m@ 717

Last change on this file since 717 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1XQTOC ;SEA/MJM - Time Out/Continue/Jump Start ;05/31/2001 10:57
2 ;;8.0;KERNEL;**20,157**;Jul 10, 1995
3 ;
4 S ^XUTL("XQ",$J,1)=XQY_XQPSM_U_XQY0,^("T")=1
5 Q:XQJS=0
6 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)
7 I '$D(^XUTL("XQO",XQDIC,"^",XQY)) D NOGO Q
8 D
9 .N %
10 .S %=$G(^XUTL("XQO",XQDIC,"^",XQY))
11 .I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY))
12 .I %]"" S XQOPTN=$P(%,"^",1,99)
13 .E D NOGO S XQFAIL=""
14 .Q
15 I $D(XQFAIL) K XQFAIL Q
16 ;
17 W !!,"You were last executing the '",$P(XQOPTN,U,3),"' menu option."
18ASK 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
19 I %=1
20 E D NOGO Q
21 ;
22 ;S XQY0=$P(^XUTL("XQO",XQDIC,"^",XQY),U,2,99)
23 D
24 .N %
25 .S %=$G(^XUTL("XQO",XQDIC,"^",XQY))
26 .I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY))
27 .I %]"" S XQY0=$P(%,"^",2,99)
28 .E D NOGO S XQFAIL=""
29 .Q
30 I $D(XQFAIL) K XQFAIL Q
31 ;
32 I $D(^XUTL("XQO",XQDIC,"^",XQY,0)) D
33 .S XQ=^(0)
34 .F XQI=1:1:XQ D
35 ..N %
36 ..S %=$G(^XUTL("XQO",XQDIC,"^",XQY,0,XQI))
37 ..I %="" S %=$G(^DIC(19,"AXQ",XQDIC,"^",XQY,0,XQI))
38 ..I %]"" S XQ(XQI)=% ;$P(^XUTL("XQO",XQDIC,"^",XQY,0,XQI),U)
39 ..Q
40 .Q
41 E S XQ=0
42 Q
43 ;
44SET ;Set up variables to GO JUMP^XQ72. Enter from ASK1+1^XQ
45 S %=^XUTL("XQ",$J,1),XQSV=+%_U_+%_U_$P(%,U,2,99)
46 K XQJS
47 Q
48 ;
49LOOK ;Look up the Jump Start Entry
50 F Q:XQUR'[U S XQUR=$P(XQUR,U,2)
51 I '$L(XQUR) D NOGO Q
52 D S^XQ75 I 'XQY D NOGO Q
53 Q
54 ;
55NOGO ;Continue fails: reset to primary menu
56 S XQY=^XUTL("XQ",$J,"XQM"),XQA3="",XQA=0 K XQCON,XQRE,XQJS,XQUR,XQOPTN
57 D S1^XQCHK ; Reconstruct XQY0
58 S $P(^XUTL("XQ",$J,0),U,3)=$P(^(0),U,3)_", NOGO"
59 Q
60 ;
61 ;
62CON ;Continue option logic. Enter from ASK^XQ on timeout.
63 W !!,"Do you want to halt and continue with this option later? YES// " R XQUR:20 S:(XQUR="")!('$T) XQUR="Y"
64 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
65 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)_" Option: " G ASK^XQ
66 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
67 S X=$P($H,",",2),X=(X>41400&(X<46800))
68 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)
69 G H^XUS
70 ;
71SS ;Search Secondaries for a particular option.
72 Q:'$D(^VA(200,DUZ,203,0)) Q:$P(^VA(200,DUZ,203,0),U,4)<1
73 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"_%
74 Q
Note: See TracBrowser for help on using the repository browser.