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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1XUS5 ;SF-ISC/STAFF - RESUME LOGIC FOR CONTINUE ;07/15/2003 12:39
2 ;;8.0;KERNEL;**313**;Jul 10, 1995
3 S %=^XUTL("XQ",$J,"XQM"),XQSV=%_U_%_U_$S($D(^XUTL("XQO","P"_%,"^",%)):$P(^(%),U,2,99),1:^DIC(19,%,0))
4 G JUMP^XQ72
5 ;
6CONT D ABT^XQ12
7C1 S XQY=^VA(200,DUZ,201),^XUTL("XQ",$J,"XQM")=XQY,^("T")=1
8 S XQY0=$S($D(^XUTL("XQO","P"_XQY,"^",XQY)):$P(^(XQY),U,2,99),1:"") I XQY0="" D S1^XQCHK
9 S XQCY=XQY D ^XQCHK I XQCY<1 S XQPRMN=1,XQL=0 D MES^XQCHK,PAUSE^XQ6 G ^XUSCLEAN
10 S XQDIC="P"_XQY,^XUTL("XQ",$J,1)=XQY_XQDIC_U_XQY0
11 I $P(XQY0,U,14),$D(^DIC(19,XQY,20)),$L(^(20)) X ^(20)
12 I $D(XQUIT) W !!,"==> The variable XQUIT encountered in the Entry Action of your Primary Menu.",*7 S XQL=0 D PAUSE^XQ6 G ^XUSCLEAN
13 I $P(XQY0,U,18),$D(^DIC(19,XQY,26)),$L(^(26)) X ^(26)
14 S XQA=0 Q:'$D(^VA(200,DUZ,202.1))
15 S %=^(202.1) K ^VA(200,DUZ,202.1) S XQY=+%,XQPSM=$P(%,XQY,2),XQDIC=$S(XQPSM[",":$P(XQPSM,",",2),1:XQPSM)
16 S XQCY=XQY D ^XQCHK I 'XQCY K XQCY,XQCY0 D NOGO Q
17 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
18 I $E(XQDIC,1)="P",XQDIC'="PXU" I $S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^DIC(19,$E(XQDIC,2,99),99.1)):1,1:0) S XQCON="" D NOGO Q
19 I XQDIC="PXU" S %=$O(^DIC(19,"B","XUCOMMAND",0)) I $S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^DIC(19,%,99.1)):1,1:0) S XQCON="" D NOGO Q
20 I '$D(^XUTL("XQO",XQDIC,"^",XQY)) D NOGO Q
21 W !!,"You were last executing the '",$P(^XUTL("XQO",XQDIC,"^",XQY),U,3),"' menu option."
22ASK 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
23 I %=1 S XQA=1,XQY0=$P(^XUTL("XQO",XQDIC,"^",XQY),U,2,99)
24 E D NOGO Q
25 I $D(^XUTL("XQO",XQDIC,"^",XQY,0)) S XQ=^(0) F XQI=1:1:XQ S XQ(XQI)=$P(^XUTL("XQO",XQDIC,"^",XQY,0,XQI),U)
26 E S XQ=0
27 Q
28 ;
29NOGO ;Continue fails: reset primary menu
30 S XQY=^XUTL("XQ",$J,"XQM"),XQA3="",XQA=0 K XQCON,XQRE
31 Q
32 ;
33EUC ; EDIT USER CHARACTERISTIC
34 N Y,XUDEV,XUIOP,IOP,DR,DIE,DA,DUOUT
35 S Y=0,XUDEV=$G(^XUTL("XQ",$J,"IOS"))
36 I $D(^VA(200,DUZ,1.2))[0 S ^(1.2)=IOST(0)
37 K XUIOP(1) D:'$D(ION) HOME^%ZIS S:'($D(XUIOP)#2) XUIOP=ION
38 I $D(^VA(200,DUZ,1.2))#2,$D(^%ZIS(2,+^(1.2),0)) S $P(XUIOP,";",2)=$P(^(0),U)
39 D TT^XUS3 G ECX:$D(DUOUT)!$D(DTOUT)
40 S POP=1,X=+$G(^VA(200,DUZ,1.2))
41 I X'=$G(^XUTL("XQ",$J,"IOST(0)")) S IOP=$S($D(^XUTL("XQ",$J,"ION")):^("ION"),1:"HOME")_";"_$P($G(^%ZIS(2,X,0)),"^"),%ZIS="M" D ^%ZIS
42 I 'POP S ^VA(200,DUZ,1.2)=IOST(0) D SAVE^XUS1
43 S DR="["_$$GET^XUPARAM("XUEDIT CHARACTERISTICS","N")_"]"
44 S DIE="^VA(200,",DA=DUZ D XUDIE
45ECX S X=$P($G(^VA(200,DUZ,200)),U,6),DUZ("AUTO")=$S(X'="":X,1:DUZ("AUTO")),X=$P($G(^(200)),U,9) I X'="" S DUZ("BUF")=(X["Y"),X=$S(DUZ("BUF"):"",1:"NO-")_"TYPE-AHEAD" X:$D(^%ZOSF(X)) ^%ZOSF(X)
46 ;DUZ("LANG")
47 K X
48 Q
49VIRTUAL ;
50 N X,Y,DIC
51 S X=$S($D(^%ZOSF("VOL")):^("VOL")_$I,1:$E($I,2,99)),DIC=3.5,DIC(0)="ML",DIC("DR")="1///"_$I_";1.9////"_$S($D(^%ZOSF("VOL")):^("VOL"),1:"")_";4////1;5////1;2////TRM;.02////"_$I D ^DIC K DIR,DR Q:Y<0 S XUDEV=+Y
52 Q
53 ;Called from several places.
54XUDIE ; Check and see if need a DDS or a DIE call
55 N J,XUDIE,DDSFILE,DIMSG
56 S:+DIE DIE=^DIC(+DIE,0,"GL") S J=$S($E(DR)="[":$E(DR,2,$L(DR)-1),1:""),XUDIE=DIE_(+DA)_",0)"
57 L +@XUDIE:2 I '$T W !,"Record in use by someone else." Q
58 I J]"",IOST["C-",$D(^DIST(.403,"B",J)) S DDSFILE=DIE D ^DDS G:'$D(DIMSG) XUDIEX
59 K DIMSG D ^DIE
60XUDIEX ;
61 D CALL^XUSERP(+DA,2) ;Call XQOR
62 L -@XUDIE Q
Note: See TracBrowser for help on using the repository browser.