XDRU1.m

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 ---XDRU1   984     printed  Apr 09, 2024@21:43:05                                                                                                                                                                                                        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