- 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 Feb 18, 2025@23:32 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
