- XQCS ;SEA/Luke - Client/Server Utilities ;09/16/2016 10:11
- ;;8.0;KERNEL;**15,28,82,116,115,177,188,157,253,569,674**;Jul 10, 1995;Build 1
- ;
- CHK(XQUSR,XQOPT,XQRPC) ;Check to see if this user can run this RPC from
- ;this option. Called by XWBSEC and XUSRB.
- ;
- ;Input: XQUSR - DUZ of user
- ; XQOPT - name or IEN of the option
- ; XQRPC - name or IEN of the remote procedure. If this
- ; variable is null no check is made to see if a
- ; procedure is allowed. That is, we only look
- ; to see if the option is there and if the user
- ; has been assigned access to it.
- ;
- ;Output: XQMES - returned as 1 if the user is allowed to use this
- ; option (and RPC is valid if XQRPC input variable is not
- ; null), or as a message string explaining why the option
- ; or RPC is not allowed.
- ;
- ;Rules: If M code exists in ^DIC(19,option#,"RPC",rpc#,1) the
- ; RULES field for a corresponding RPC, the software sets
- ; the flag XQRPCOK to 1 and executes the field's code.
- ; If the flag is returned as less than 1, the request for
- ; use of that RPC is denied. Rules are written by the
- ; package developer and are not required.
- ;
- ;
- N %,X,XQCY0,XQDIC,XQKEY,XQRPCOK,XQPM,XQSM,XQSMY,XQYSAV
- ;
- I '$G(XQUSR) K ^TMP("XQCS",$J) ;p674 kill ^TMP global upon new session
- S XQMES=1
- D OPT I 'XQMES Q XQMES
- I ($G(XQY0)'="XUS SIGNON")&(XQUSR>0) D USER I 'XQMES Q XQMES
- S %=$G(XQRPC) I %]"" S XQRPC=% D RPC I 'XQMES Q XQMES
- Q XQMES
- ;
- ;
- OPT ;See if the option is there and is a broker type option
- I XQOPT'=+XQOPT S XQOPT=$O(^DIC(19,"B",XQOPT,0))
- I XQOPT'>0 S XQMES="No such option in the ""B"" cross reference of the Option File." Q
- I $G(MODE)="CHECK" D OPT1 Q
- I '$D(^TMP("XQCS",$J)) S XQOPT=$$OPTLK($P(^DIC(19,XQOPT,0),U))
- Q
- OPT1 ;
- I XQOPT'=+XQOPT S XQOPT=$O(^DIC(19,"B",XQOPT,0)) I XQOPT'>0 S XQMES="No such option in the ""B"" cross reference of the Option File." Q
- I '$D(^DIC(19,XQOPT,0)) S XQMES="No such option in the Option File." Q
- ;I $P(^DIC(19,XQOPT,0),U,4)'="B" S XQMES="This option is not a Client/Server-type option." Q
- ;
- ;Check for Out-Of-Order, etc. Patch XU*8*38 7/16/96
- ;
- S XQCY0=^DIC(19,XQOPT,0) ;W XQCY0
- I $L($P(XQCY0,U,3)) S XQMES="Option out of order with message: "_$P(XQCY0,U,3)_"." Q
- I $L($P(XQCY0,U,6)) S %=$P(XQCY0,U,6) I '$D(^XUSEC(%,DUZ)) S XQMES="Option locked, "_$P(^VA(200,DUZ,0),U)_" does not hold the key." Q
- I $L($P(XQCY0,U,16)) I $D(^DIC(19,XQOPT,3)),^(3)]"" S %=^(3) I $D(^XUSEC(%,DUZ)) S XQMES="Reverse lock, "_$P(^VA(200,DUZ,0),U)_" holds the key." Q
- I $L($P(XQCY0,U,9)) S XQZ=$P(XQCY0,U,9) D ^XQDATE S (XX,X)=% D XQO^XQ92 I X=""!(XX'=X) S XQMES="This option is time restricted." Q
- I $D(^DIC(19,+XQOPT,3.91)),$P(^(3.91,0),U,4)>1 S:$D(XQY) XQYSAV=XQY D ^XQDATE S X=%,XQY=+XQOPT D ^XQ92 S:$D(XQYSAV) XQY=XQYSAV I X="" S XQMES="This option is time restricted." Q
- ;End patch 38
- Q
- ;
- OPTLK(V) ;Lookup a Option in the file, Return it's IEN
- N XQOPT S XQOPT=$O(^DIC(19,"B",V,0)) I XQOPT'>0 Q ""
- I '$D(XQMES) N XQMES S XQMES=1
- N XQCS,XQCSO S XQCS(XQOPT)="" N XQOPT K ^TMP("XQCS",$J)
- F S XQOPT=$O(XQCS("")) Q:XQOPT="" K XQCS(XQOPT) I '$D(XQCSO(XQOPT)) D OPT1 D:XQMES I 'XQMES Q
- . N I,J F I=0:0 S I=$O(^DIC(19,XQOPT,"RPC",I)) Q:I'>0 K J S J=^(I,0) S:$D(^(1)) J(1)=^(1) I '$D(^TMP("XQCS",$J,+J)) S ^TMP("XQCS",$J,+J,0)=J I $D(J(1)) S ^(1)=J(1)
- . F I=0:0 S I=$O(^DIC(19,XQOPT,10,I)) Q:I'>0 S J=+^(I,0) I $P(^DIC(19,J,0),U,4)="B" S XQCS(J)=""
- . S XQCSO(XQOPT)=""
- . Q
- Q $O(^DIC(19,"B",V,0))
- ;
- RPC ;See if rpc exsists, is registered, is locked, etc.
- ; I '$D(^DIC(19,XQOPT,"RPC",0)) S XQMES="No RPC subfile defined for the option "_$P(^DIC(19,XQOPT,0),U)_"." Q
- ; I $P(^DIC(19,XQOPT,"RPC",0),U,4)<1 S XQMES="No remote procedure calls registered for the option "_$P(^DIC(19,XQOPT,0),U)_"." Q
- I XQRPC'=+XQRPC S XQRPC=$O(^XWB(8994,"B",XQRPC,0)) I XQRPC'>0 S XQMES="No RPC by that name in the ""B"" cross-reference of the Remote Procedure File." Q
- I '$D(^XWB(8994,XQRPC,0)) S XQMES="No such procedure in the Remote Procedure File." Q
- ; I '$D(^DIC(19,XQOPT,"RPC","B",XQRPC)) S XQMES="The remote procedure "_$P(^XWB(8994,XQRPC,0),U)_" is not registered to the option "_$P(^DIC(19,XQOPT,0),U)_"." Q
- I '$D(^TMP("XQCS",$J,XQRPC)) S XQMES="The remote procedure "_$P(^XWB(8994,XQRPC,0),U)_" is not registered to the option "_$P(^DIC(19,XQOPT,0),U)_"." Q
- ; S %=$O(^DIC(19,XQOPT,"RPC","B",XQRPC,0)),XQKEY=$P(^DIC(19,XQOPT,"RPC",%,0),U,2)
- S XQKEY=$P(^TMP("XQCS",$J,XQRPC,0),U,2)
- I $L(XQKEY) I '$D(^XUSEC(XQKEY,XQUSR)) S XQMES="Remote procedure is locked." Q
- ;
- RULES ;Check the rules for this RPC
- ;S %=$O(^DIC(19,XQOPT,"RPC","B",XQRPC,0))
- ;I $D(^DIC(19,XQOPT,"RPC",%,1)),$L(^(1)) D
- I $D(^TMP("XQCS",$J,XQRPC,1)),$L(^(1)) D
- . S XQRPCOK=1
- . X ^TMP("XQCS",$J,XQRPC,1)
- . I XQRPCOK<1 S XQMES="Remote procedure request failed rules test."
- . Q
- Q
- ;
- ;
- ;
- USER ;See if XQUSR has been assigned access this option or not
- ;
- N XQYES
- S XQMES=1,(XQSMY,%,XQYES)=0
- ;
- TOP ;See if XQOPT is on top level of a tree: primary, secondary, or common
- S XQPM=+$G(^VA(200,XQUSR,201)) I XQOPT=XQPM Q
- ;
- ;Check the Common Options (XUCOMMAND)
- I $D(^DIC(19,"B","XUCOMMAND")) D
- . N XQCOM
- . S XQCOM=$O(^DIC(19,"B","XUCOMMAND",0))
- . I $D(^DIC(19,XQCOM,10,"B",XQOPT)) S XQYES=1
- . I XQYES Q
- . I '$D(^XUTL("XQO","PXU",0)) S %=$$BUILD("PXU")
- . I $D(^XUTL("XQO","PXU","^",XQOPT)) S XQYES=1
- . Q
- I XQYES Q
- ;
- ;
- I $D(^VA(200,XQUSR,203,0)),$P(^(0),U,4)>0 S XQSMY=1 D
- .;** P569 START CJM
- .N DUZ S DUZ=XQUSR
- .;** P569 END CJM
- . S XQDIC="U"_XQUSR I $S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^VA(200,XQUSR,203.1)):1,1:^VA(200,XQUSR,203.1)'=$P(^XUTL("XQO",XQDIC,0),U,2)) D ^XQSET
- . S (XQSM,%)=0
- . F Q:% S XQSM=$O(^XUTL("XQO",XQDIC,"^",XQSM)) Q:XQSM="" I XQSM=XQOPT S XQYES=1 Q
- . Q
- I XQYES Q
- ;
- DEEP ;See if it's under the top somewhere - start with primary tree
- I XQPM>0 D
- .S XQDIC="P"_XQPM
- .S XQYES=$S($D(^XUTL("XQO",XQDIC,"^",XQOPT)):1,$D(^DIC(19,"AXQ",XQDIC,"^",XQOPT)):1,1:0)
- .Q
- I XQYES Q
- ;
- ;Check secondary trees
- S (XQSM,%)=0
- I XQSMY F Q:XQYES S XQSM=$O(^XUTL("XQO","U"_XQUSR,"^",XQSM)) Q:XQSM="" D
- .S XQDIC="P"_XQSM
- .S XQYES=$S($D(^XUTL("XQO",XQDIC,"^",XQOPT)):1,$D(^DIC(19,"AXQ",XQDIC,"^",XQOPT)):1,1:0)
- . Q
- I XQYES Q
- ;
- I $L(XQMES<5) S XQMES="User "_$P(^VA(200,XQUSR,0),U)_" does not have access to option "_$P(^DIC(19,XQOPT,0),U)
- Q
- ;
- ;End of main program
- ;
- BUILD(XQDIC) ;A missing ^XUTL node brings us here
- I $D(^DIC(19,"AXQ",XQDIC)) D
- .L +^DIC(19,"AXQ",XQDIC):5
- .I '$D(^XUTL("XQO",XQDIC)) M ^XUTL("XQO",XQDIC)=^DIC(19,"AXQ",XQDIC)
- .L -^DIC(19,"AXQ",XQDIC)
- .Q
- I $D(^XUTL("XQO",XQDIC,0)) Q 1
- ;
- ;If they are not even in ^DIC the make them from scratch
- I '$D(^DIC(19,"AXQ",XQDIC)) D
- .;D REACT^XQ84(DUZ)
- .S XQMES="Your menus are being rebuilt. Please try again later."
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQCS 7013 printed Feb 18, 2025@23:32:03 Page 2
- XQCS ;SEA/Luke - Client/Server Utilities ;09/16/2016 10:11
- +1 ;;8.0;KERNEL;**15,28,82,116,115,177,188,157,253,569,674**;Jul 10, 1995;Build 1
- +2 ;
- CHK(XQUSR,XQOPT,XQRPC) ;Check to see if this user can run this RPC from
- +1 ;this option. Called by XWBSEC and XUSRB.
- +2 ;
- +3 ;Input: XQUSR - DUZ of user
- +4 ; XQOPT - name or IEN of the option
- +5 ; XQRPC - name or IEN of the remote procedure. If this
- +6 ; variable is null no check is made to see if a
- +7 ; procedure is allowed. That is, we only look
- +8 ; to see if the option is there and if the user
- +9 ; has been assigned access to it.
- +10 ;
- +11 ;Output: XQMES - returned as 1 if the user is allowed to use this
- +12 ; option (and RPC is valid if XQRPC input variable is not
- +13 ; null), or as a message string explaining why the option
- +14 ; or RPC is not allowed.
- +15 ;
- +16 ;Rules: If M code exists in ^DIC(19,option#,"RPC",rpc#,1) the
- +17 ; RULES field for a corresponding RPC, the software sets
- +18 ; the flag XQRPCOK to 1 and executes the field's code.
- +19 ; If the flag is returned as less than 1, the request for
- +20 ; use of that RPC is denied. Rules are written by the
- +21 ; package developer and are not required.
- +22 ;
- +23 ;
- +24 NEW %,X,XQCY0,XQDIC,XQKEY,XQRPCOK,XQPM,XQSM,XQSMY,XQYSAV
- +25 ;
- +26 ;p674 kill ^TMP global upon new session
- IF '$GET(XQUSR)
- KILL ^TMP("XQCS",$JOB)
- +27 SET XQMES=1
- +28 DO OPT
- IF 'XQMES
- QUIT XQMES
- +29 IF ($GET(XQY0)'="XUS SIGNON")&(XQUSR>0)
- DO USER
- IF 'XQMES
- QUIT XQMES
- +30 SET %=$GET(XQRPC)
- IF %]""
- SET XQRPC=%
- DO RPC
- IF 'XQMES
- QUIT XQMES
- +31 QUIT XQMES
- +32 ;
- +33 ;
- OPT ;See if the option is there and is a broker type option
- +1 IF XQOPT'=+XQOPT
- SET XQOPT=$ORDER(^DIC(19,"B",XQOPT,0))
- +2 IF XQOPT'>0
- SET XQMES="No such option in the ""B"" cross reference of the Option File."
- QUIT
- +3 IF $GET(MODE)="CHECK"
- DO OPT1
- QUIT
- +4 IF '$DATA(^TMP("XQCS",$JOB))
- SET XQOPT=$$OPTLK($PIECE(^DIC(19,XQOPT,0),U))
- +5 QUIT
- OPT1 ;
- +1 IF XQOPT'=+XQOPT
- SET XQOPT=$ORDER(^DIC(19,"B",XQOPT,0))
- IF XQOPT'>0
- SET XQMES="No such option in the ""B"" cross reference of the Option File."
- QUIT
- +2 IF '$DATA(^DIC(19,XQOPT,0))
- SET XQMES="No such option in the Option File."
- QUIT
- +3 ;I $P(^DIC(19,XQOPT,0),U,4)'="B" S XQMES="This option is not a Client/Server-type option." Q
- +4 ;
- +5 ;Check for Out-Of-Order, etc. Patch XU*8*38 7/16/96
- +6 ;
- +7 ;W XQCY0
- SET XQCY0=^DIC(19,XQOPT,0)
- +8 IF $LENGTH($PIECE(XQCY0,U,3))
- SET XQMES="Option out of order with message: "_$PIECE(XQCY0,U,3)_"."
- QUIT
- +9 IF $LENGTH($PIECE(XQCY0,U,6))
- SET %=$PIECE(XQCY0,U,6)
- IF '$DATA(^XUSEC(%,DUZ))
- SET XQMES="Option locked, "_$PIECE(^VA(200,DUZ,0),U)_" does not hold the key."
- QUIT
- +10 IF $LENGTH($PIECE(XQCY0,U,16))
- IF $DATA(^DIC(19,XQOPT,3))
- IF ^(3)]""
- SET %=^(3)
- IF $DATA(^XUSEC(%,DUZ))
- SET XQMES="Reverse lock, "_$PIECE(^VA(200,DUZ,0),U)_" holds the key."
- QUIT
- +11 IF $LENGTH($PIECE(XQCY0,U,9))
- SET XQZ=$PIECE(XQCY0,U,9)
- DO ^XQDATE
- SET (XX,X)=%
- DO XQO^XQ92
- IF X=""!(XX'=X)
- SET XQMES="This option is time restricted."
- QUIT
- +12 IF $DATA(^DIC(19,+XQOPT,3.91))
- IF $PIECE(^(3.91,0),U,4)>1
- if $DATA(XQY)
- SET XQYSAV=XQY
- DO ^XQDATE
- SET X=%
- SET XQY=+XQOPT
- DO ^XQ92
- if $DATA(XQYSAV)
- SET XQY=XQYSAV
- IF X=""
- SET XQMES="This option is time restricted."
- QUIT
- +13 ;End patch 38
- +14 QUIT
- +15 ;
- OPTLK(V) ;Lookup a Option in the file, Return it's IEN
- +1 NEW XQOPT
- SET XQOPT=$ORDER(^DIC(19,"B",V,0))
- IF XQOPT'>0
- QUIT ""
- +2 IF '$DATA(XQMES)
- NEW XQMES
- SET XQMES=1
- +3 NEW XQCS,XQCSO
- SET XQCS(XQOPT)=""
- NEW XQOPT
- KILL ^TMP("XQCS",$JOB)
- +4 FOR
- SET XQOPT=$ORDER(XQCS(""))
- if XQOPT=""
- QUIT
- KILL XQCS(XQOPT)
- IF '$DATA(XQCSO(XQOPT))
- DO OPT1
- if XQMES
- Begin DoDot:1
- +5 NEW I,J
- FOR I=0:0
- SET I=$ORDER(^DIC(19,XQOPT,"RPC",I))
- if I'>0
- QUIT
- KILL J
- SET J=^(I,0)
- if $DATA(^(1))
- SET J(1)=^(1)
- IF '$DATA(^TMP("XQCS",$JOB,+J))
- SET ^TMP("XQCS",$JOB,+J,0)=J
- IF $DATA(J(1))
- SET ^(1)=J(1)
- +6 FOR I=0:0
- SET I=$ORDER(^DIC(19,XQOPT,10,I))
- if I'>0
- QUIT
- SET J=+^(I,0)
- IF $PIECE(^DIC(19,J,0),U,4)="B"
- SET XQCS(J)=""
- +7 SET XQCSO(XQOPT)=""
- +8 QUIT
- End DoDot:1
- IF 'XQMES
- QUIT
- +9 QUIT $ORDER(^DIC(19,"B",V,0))
- +10 ;
- RPC ;See if rpc exsists, is registered, is locked, etc.
- +1 ; I '$D(^DIC(19,XQOPT,"RPC",0)) S XQMES="No RPC subfile defined for the option "_$P(^DIC(19,XQOPT,0),U)_"." Q
- +2 ; I $P(^DIC(19,XQOPT,"RPC",0),U,4)<1 S XQMES="No remote procedure calls registered for the option "_$P(^DIC(19,XQOPT,0),U)_"." Q
- +3 IF XQRPC'=+XQRPC
- SET XQRPC=$ORDER(^XWB(8994,"B",XQRPC,0))
- IF XQRPC'>0
- SET XQMES="No RPC by that name in the ""B"" cross-reference of the Remote Procedure File."
- QUIT
- +4 IF '$DATA(^XWB(8994,XQRPC,0))
- SET XQMES="No such procedure in the Remote Procedure File."
- QUIT
- +5 ; I '$D(^DIC(19,XQOPT,"RPC","B",XQRPC)) S XQMES="The remote procedure "_$P(^XWB(8994,XQRPC,0),U)_" is not registered to the option "_$P(^DIC(19,XQOPT,0),U)_"." Q
- +6 IF '$DATA(^TMP("XQCS",$JOB,XQRPC))
- SET XQMES="The remote procedure "_$PIECE(^XWB(8994,XQRPC,0),U)_" is not registered to the option "_$PIECE(^DIC(19,XQOPT,0),U)_"."
- QUIT
- +7 ; S %=$O(^DIC(19,XQOPT,"RPC","B",XQRPC,0)),XQKEY=$P(^DIC(19,XQOPT,"RPC",%,0),U,2)
- +8 SET XQKEY=$PIECE(^TMP("XQCS",$JOB,XQRPC,0),U,2)
- +9 IF $LENGTH(XQKEY)
- IF '$DATA(^XUSEC(XQKEY,XQUSR))
- SET XQMES="Remote procedure is locked."
- QUIT
- +10 ;
- RULES ;Check the rules for this RPC
- +1 ;S %=$O(^DIC(19,XQOPT,"RPC","B",XQRPC,0))
- +2 ;I $D(^DIC(19,XQOPT,"RPC",%,1)),$L(^(1)) D
- +3 IF $DATA(^TMP("XQCS",$JOB,XQRPC,1))
- IF $LENGTH(^(1))
- Begin DoDot:1
- +4 SET XQRPCOK=1
- +5 XECUTE ^TMP("XQCS",$JOB,XQRPC,1)
- +6 IF XQRPCOK<1
- SET XQMES="Remote procedure request failed rules test."
- +7 QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- +10 ;
- +11 ;
- USER ;See if XQUSR has been assigned access this option or not
- +1 ;
- +2 NEW XQYES
- +3 SET XQMES=1
- SET (XQSMY,%,XQYES)=0
- +4 ;
- TOP ;See if XQOPT is on top level of a tree: primary, secondary, or common
- +1 SET XQPM=+$GET(^VA(200,XQUSR,201))
- IF XQOPT=XQPM
- QUIT
- +2 ;
- +3 ;Check the Common Options (XUCOMMAND)
- +4 IF $DATA(^DIC(19,"B","XUCOMMAND"))
- Begin DoDot:1
- +5 NEW XQCOM
- +6 SET XQCOM=$ORDER(^DIC(19,"B","XUCOMMAND",0))
- +7 IF $DATA(^DIC(19,XQCOM,10,"B",XQOPT))
- SET XQYES=1
- +8 IF XQYES
- QUIT
- +9 IF '$DATA(^XUTL("XQO","PXU",0))
- SET %=$$BUILD("PXU")
- +10 IF $DATA(^XUTL("XQO","PXU","^",XQOPT))
- SET XQYES=1
- +11 QUIT
- End DoDot:1
- +12 IF XQYES
- QUIT
- +13 ;
- +14 ;
- +15 IF $DATA(^VA(200,XQUSR,203,0))
- IF $PIECE(^(0),U,4)>0
- SET XQSMY=1
- Begin DoDot:1
- +16 ;** P569 START CJM
- +17 NEW DUZ
- SET DUZ=XQUSR
- +18 ;** P569 END CJM
- +19 SET XQDIC="U"_XQUSR
- IF $SELECT('$DATA(^XUTL("XQO",XQDIC,0)):1,'$DATA(^VA(200,XQUSR,203.1)):1,1:^VA(200,XQUSR,203.1)'=$PIECE(^XUTL("XQO",XQDIC,0),U,2))
- DO ^XQSET
- +20 SET (XQSM,%)=0
- +21 FOR
- if %
- QUIT
- SET XQSM=$ORDER(^XUTL("XQO",XQDIC,"^",XQSM))
- if XQSM=""
- QUIT
- IF XQSM=XQOPT
- SET XQYES=1
- QUIT
- +22 QUIT
- End DoDot:1
- +23 IF XQYES
- QUIT
- +24 ;
- DEEP ;See if it's under the top somewhere - start with primary tree
- +1 IF XQPM>0
- Begin DoDot:1
- +2 SET XQDIC="P"_XQPM
- +3 SET XQYES=$SELECT($DATA(^XUTL("XQO",XQDIC,"^",XQOPT)):1,$DATA(^DIC(19,"AXQ",XQDIC,"^",XQOPT)):1,1:0)
- +4 QUIT
- End DoDot:1
- +5 IF XQYES
- QUIT
- +6 ;
- +7 ;Check secondary trees
- +8 SET (XQSM,%)=0
- +9 IF XQSMY
- FOR
- if XQYES
- QUIT
- SET XQSM=$ORDER(^XUTL("XQO","U"_XQUSR,"^",XQSM))
- if XQSM=""
- QUIT
- Begin DoDot:1
- +10 SET XQDIC="P"_XQSM
- +11 SET XQYES=$SELECT($DATA(^XUTL("XQO",XQDIC,"^",XQOPT)):1,$DATA(^DIC(19,"AXQ",XQDIC,"^",XQOPT)):1,1:0)
- +12 QUIT
- End DoDot:1
- +13 IF XQYES
- QUIT
- +14 ;
- +15 IF $LENGTH(XQMES<5)
- SET XQMES="User "_$PIECE(^VA(200,XQUSR,0),U)_" does not have access to option "_$PIECE(^DIC(19,XQOPT,0),U)
- +16 QUIT
- +17 ;
- +18 ;End of main program
- +19 ;
- BUILD(XQDIC) ;A missing ^XUTL node brings us here
- +1 IF $DATA(^DIC(19,"AXQ",XQDIC))
- Begin DoDot:1
- +2 LOCK +^DIC(19,"AXQ",XQDIC):5
- +3 IF '$DATA(^XUTL("XQO",XQDIC))
- MERGE ^XUTL("XQO",XQDIC)=^DIC(19,"AXQ",XQDIC)
- +4 LOCK -^DIC(19,"AXQ",XQDIC)
- +5 QUIT
- End DoDot:1
- +6 IF $DATA(^XUTL("XQO",XQDIC,0))
- QUIT 1
- +7 ;
- +8 ;If they are not even in ^DIC the make them from scratch
- +9 IF '$DATA(^DIC(19,"AXQ",XQDIC))
- Begin DoDot:1
- +10 ;D REACT^XQ84(DUZ)
- +11 SET XQMES="Your menus are being rebuilt. Please try again later."
- End DoDot:1
- +12 QUIT 0