source: FOIAVistA/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRU1.m@ 1608

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

initial load of FOIAVistA 6/30/08 version

File size: 961 bytes
Line 
1XDRU1 ;IHS/OHPRD/JCM - XDR GENERAL UTILITIES; ;07/08/93 15:28
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3CHECK ; EP - Called by XDRDQUE
4 I $P(XDRD(0),U,9)']"" S XDRERR=1 D ^XDREMSG
5 I $P(XDRD(0),U,9)]"" S X=$S($P(XDRD(0),U,9)["-":$P($P(XDRD(0),U,9),"-",2),1:$P(XDRD(0),U,9)) X ^%ZOSF("TEST") I '$T S XDRERR=2 D ^XDREMSG
6 I $P(XDRD(0),U,15)']"" S XDRERR=3 D ^XDREMSG
7 I '$O(^VA(15.1,$P(XDRD(0),U,1),11,0)) S XDRERR=4 D ^XDREMSG
8 I '$D(^DIC(XDRFL,0,"GL")) S XDRERR=5 D ^XDREMSG
9 Q
10 ;
11LOCK ; EP - Called by XDRMAIN,XDRMRG
12 S %=XDRMRG("LCK")_XDRGL_XDRMCD_"):0" L @% E S XDRMLOCK=1 G LOCKX
13 S %=XDRMRG("LCK")_XDRGL_XDRMCD2_"):0" L @% E S XDRMLOCK=1 G LOCKX
14 I $D(XDRM("DINUMS")) K XDRI F XDRI=0:0 S XDRI=$O(XDRM("DINUMS",XDRI)) Q:'XDRI D LOCK2
15LOCKX K XDRI,%
16 Q
17 ;
18LOCK2 ;
19 S XDRMRG("GL")=^DIC(XDRI,0,"GL")
20 S %=XDRMRG("LCK")_XDRMRG("GL")_XDRMCD_"):0" L @% E S XDRMLOCK=1 G LOCK2X
21 S %=XDRMRG("LCK")_XDRMRG("GL")_XDRMCD2_"):0" L @% E S XDRMLOCK=1
22LOCK2X K XDRMRG("GL"),%
23 Q
Note: See TracBrowser for help on using the repository browser.