XDRU1 ;IHS/OHPRD/JCM - XDR GENERAL UTILITIES; ;07/08/93 15:28
;;7.3;TOOLKIT;;Apr 25, 1995
CHECK ; EP - Called by XDRDQUE
I $P(XDRD(0),U,9)']"" S XDRERR=1 D ^XDREMSG
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
I $P(XDRD(0),U,15)']"" S XDRERR=3 D ^XDREMSG
I '$O(^VA(15.1,$P(XDRD(0),U,1),11,0)) S XDRERR=4 D ^XDREMSG
I '$D(^DIC(XDRFL,0,"GL")) S XDRERR=5 D ^XDREMSG
Q
;
LOCK ; EP - Called by XDRMAIN,XDRMRG
S %=XDRMRG("LCK")_XDRGL_XDRMCD_"):0" L @% E S XDRMLOCK=1 G LOCKX
S %=XDRMRG("LCK")_XDRGL_XDRMCD2_"):0" L @% E S XDRMLOCK=1 G LOCKX
I $D(XDRM("DINUMS")) K XDRI F XDRI=0:0 S XDRI=$O(XDRM("DINUMS",XDRI)) Q:'XDRI D LOCK2
LOCKX K XDRI,%
Q
;
LOCK2 ;
S XDRMRG("GL")=^DIC(XDRI,0,"GL")
S %=XDRMRG("LCK")_XDRMRG("GL")_XDRMCD_"):0" L @% E S XDRMLOCK=1 G LOCK2X
S %=XDRMRG("LCK")_XDRMRG("GL")_XDRMCD2_"):0" L @% E S XDRMLOCK=1
LOCK2X K XDRMRG("GL"),%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRU1 984 printed Dec 13, 2024@02:39:52 Page 2
XDRU1 ;IHS/OHPRD/JCM - XDR GENERAL UTILITIES; ;07/08/93 15:28
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
CHECK ; EP - Called by XDRDQUE
+1 IF $PIECE(XDRD(0),U,9)']""
SET XDRERR=1
DO ^XDREMSG
+2 IF $PIECE(XDRD(0),U,9)]""
SET X=$SELECT($PIECE(XDRD(0),U,9)["-":$PIECE($PIECE(XDRD(0),U,9),"-",2),1:$PIECE(XDRD(0),U,9))
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET XDRERR=2
DO ^XDREMSG
+3 IF $PIECE(XDRD(0),U,15)']""
SET XDRERR=3
DO ^XDREMSG
+4 IF '$ORDER(^VA(15.1,$PIECE(XDRD(0),U,1),11,0))
SET XDRERR=4
DO ^XDREMSG
+5 IF '$DATA(^DIC(XDRFL,0,"GL"))
SET XDRERR=5
DO ^XDREMSG
+6 QUIT
+7 ;
LOCK ; EP - Called by XDRMAIN,XDRMRG
+1 SET %=XDRMRG("LCK")_XDRGL_XDRMCD_"):0"
LOCK @%
IF '$TEST
SET XDRMLOCK=1
GOTO LOCKX
+2 SET %=XDRMRG("LCK")_XDRGL_XDRMCD2_"):0"
LOCK @%
IF '$TEST
SET XDRMLOCK=1
GOTO LOCKX
+3 IF $DATA(XDRM("DINUMS"))
KILL XDRI
FOR XDRI=0:0
SET XDRI=$ORDER(XDRM("DINUMS",XDRI))
if 'XDRI
QUIT
DO LOCK2
LOCKX KILL XDRI,%
+1 QUIT
+2 ;
LOCK2 ;
+1 SET XDRMRG("GL")=^DIC(XDRI,0,"GL")
+2 SET %=XDRMRG("LCK")_XDRMRG("GL")_XDRMCD_"):0"
LOCK @%
IF '$TEST
SET XDRMLOCK=1
GOTO LOCK2X
+3 SET %=XDRMRG("LCK")_XDRMRG("GL")_XDRMCD2_"):0"
LOCK @%
IF '$TEST
SET XDRMLOCK=1
LOCK2X KILL XDRMRG("GL"),%
+1 QUIT
