- 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 Feb 19, 2025@00:06:20 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
