XQCHK1 ;BP-OAK/BDT - Check security on option; 5/12/03 12:32pm
;;8.0;KERNEL;**303**; Jul 10,1995
Q
CHCK1 ;check if there is another path to access a specific option
N XQK,XQK1,XQK2,XQK3,XQK4,I,J,KFG1,KFG2 S KFG=0,XQK=0
Q:'$D(^XUTL("XQO",XQDIC,"^",%XQOP,0))
F S XQK=$O(^XUTL("XQO",XQDIC,"^",%XQOP,0,XQK)) Q:XQK="" D
.S XQK1=$P($G(^XUTL("XQO",XQDIC,"^",%XQOP,0,XQK)),"^",2)
.S XQK3=$P($G(^XUTL("XQO",XQDIC,"^",%XQOP,0,XQK)),"^",5)
.I XQK1="",XQK3="" S KFG=1 Q
.S KFG1=1,KFG2=1
.F I=1:1 S XQK2=$P(XQK1,",",I) Q:XQK2="" D
..I $D(^XUSEC(XQK2,%XQUSR)) S KFG1=KFG1+1
.F J=1:1 S XQK4=$P(XQK3,",",J) Q:XQK4="" D
..I '$D(^XUSEC(XQK4,%XQUSR)) S KFG2=KFG2+1
.I KFG1=I,KFG2=J S KFG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQCHK1 709 printed Dec 13, 2024@02:05:34 Page 2
XQCHK1 ;BP-OAK/BDT - Check security on option; 5/12/03 12:32pm
+1 ;;8.0;KERNEL;**303**; Jul 10,1995
+2 QUIT
CHCK1 ;check if there is another path to access a specific option
+1 NEW XQK,XQK1,XQK2,XQK3,XQK4,I,J,KFG1,KFG2
SET KFG=0
SET XQK=0
+2 if '$DATA(^XUTL("XQO",XQDIC,"^",%XQOP,0))
QUIT
+3 FOR
SET XQK=$ORDER(^XUTL("XQO",XQDIC,"^",%XQOP,0,XQK))
if XQK=""
QUIT
Begin DoDot:1
+4 SET XQK1=$PIECE($GET(^XUTL("XQO",XQDIC,"^",%XQOP,0,XQK)),"^",2)
+5 SET XQK3=$PIECE($GET(^XUTL("XQO",XQDIC,"^",%XQOP,0,XQK)),"^",5)
+6 IF XQK1=""
IF XQK3=""
SET KFG=1
QUIT
+7 SET KFG1=1
SET KFG2=1
+8 FOR I=1:1
SET XQK2=$PIECE(XQK1,",",I)
if XQK2=""
QUIT
Begin DoDot:2
+9 IF $DATA(^XUSEC(XQK2,%XQUSR))
SET KFG1=KFG1+1
End DoDot:2
+10 FOR J=1:1
SET XQK4=$PIECE(XQK3,",",J)
if XQK4=""
QUIT
Begin DoDot:2
+11 IF '$DATA(^XUSEC(XQK4,%XQUSR))
SET KFG2=KFG2+1
End DoDot:2
+12 IF KFG1=I
IF KFG2=J
SET KFG=1
End DoDot:1
+13 QUIT
