XQCHK2 ; OAK-BP/BDT - Internal APIs to check Keys for options; 4/28/11
;;8.0;KERNEL;**427,503,570**;Jul 10, 1995;Build 3
;;"Per VHA Directive 2004-038, this routine should not be modified".
Q
;; These Internal Kernel APIs are using in the routine XQCHK
;; to check Keys for options
;;
CHCKL(XQCY0,XQDUZ) ;Entry point for checking all Locks for an option
;; XQCY0 is $P(^XUTL("XQO",XQDIC,"^",%XQOP),"^",2,99)
;; XQDUZ is IEN of user
;; Return XQRT: Zero or 1^Key found that user needed for the option
S XQCY0=$G(XQCY0)
N XQI,XQY,XQX,XQRT,XQK S (XQRT,XQX)=0
;check Key for the option; p457
S XQY=$P(XQCY0,"^"),XQX=$$GETIEN(XQY)
I +XQX S XQK=$$GET1^DIQ(19,XQX,3)
I $G(XQK)'="",'$D(^XUSEC(XQK,XQDUZ)) S XQRT=1_"^"_XQK Q XQRT
;loop through higher menu options.
S XQY=$P(XQCY0,"^",5)
F XQI=1:1 S XQX=$P(XQY,",",XQI) Q:'XQX D
. I +XQX S XQK=$$GET1^DIQ(19,XQX,3) I XQK'="",'$D(^XUSEC(XQK,XQDUZ)) S XQRT=1_"^"_XQK Q
Q XQRT
;
CHCKRL(XQCY0,XQDUZ) ;Entry point for checking all Reversed Locks for an option
;; XQCY0 is $P(^XUTL("XQO",XQDIC,"^",%XQOP),"^",2,99)
;; XQDUZ is IEN of user
;; Return XQRT: Zero or 1^Reversed Key found that user has
S XQCY0=$G(XQCY0)
N XQI,XQY,XQX,XQRT,XQK S (XQRT,XQX)=0
;check Reversed Key for the option; p457
S XQY=$P(XQCY0,"^"),XQX=$$GETIEN(XQY)
I +XQX S XQK=$$GET1^DIQ(19,XQX,3.01)
I $G(XQK)'="",$D(^XUSEC(XQK,XQDUZ)) S XQRT=1_"^"_XQK Q XQRT
;loop through higher menu options.
S XQY=$P(XQCY0,"^",5)
F XQI=1:1 S XQX=$P(XQY,",",XQI) Q:'XQX D
. I +XQX S XQK=$$GET1^DIQ(19,XQX,3.01) I XQK'="",$D(^XUSEC(XQK,XQDUZ)) S XQRT=1_"^"_XQK Q
Q XQRT
;
GETIEN(XQNAME) ;get IEN for an option; 457
;; XQNAME is name of an option
;; Retrun XQIEN: Null or IEN if existed
N XQIEN S XQIEN=""
I $G(XQNAME)="" Q XQIEN
I '$D(^DIC(19,"B",XQNAME)) Q XQIEN
S XQIEN=$O(^DIC(19,"B",XQNAME,XQIEN))
Q XQIEN
;
CHKTOPL(XQIEN,XQDUZ) ;Check Lock for the top level of the secondary options
;this need to be called to check the top level first when check the
;Locks for lower menu option because the 6th piece of ^XUTL does not
;contain the IEN of the top menu option.
N XQRT,XQK S XQRT=0
I XQIEN'=+$G(XQIEN) Q XQRT
S XQK=$$GET1^DIQ(19,XQIEN,3)
I $G(XQK)'="",'$D(^XUSEC(XQK,XQDUZ)) S XQRT=1_"^"_XQK
Q XQRT
;
CHKTOPRL(XQIEN,XQDUZ) ;Check Reversed Lock the top level of the secondary options
;this need to be called to check the top level first when check the
;Reversed Locks for lower menu option because the 6th piece of ^XUTL does not
;contain the IEN of the top menu option.
N XQRT,XQK S XQRT=0
I XQIEN'=+$G(XQIEN) Q XQRT
S XQK=$$GET1^DIQ(19,XQIEN,3.01)
I $G(XQK)'="",$D(^XUSEC(XQK,XQDUZ)) S XQRT=1_"^"_XQK
Q XQRT
;
CHKOOO(XQCY0) ; Check OOO option
;; XQCY0 is $P(^XUTL("XQO",XQDIC,"^",%XQOP),"^",2,99)
;; Return XQRT: Zero or 1^Out Of Order message
S XQCY0=$G(XQCY0)
N XQI,XQY,XQX,XQRT,XQK S (XQRT,XQX)=0
;check Out Of Order
S XQY=$P(XQCY0,"^"),XQX=$$GETIEN(XQY)
I +XQX S XQK=$$GET1^DIQ(19,XQX,2)
I $G(XQK)'="" Q "1^"_$G(XQK)
;loop through higher menu options.
S XQY=$P(XQCY0,"^",5)
F XQI=1:1 S XQX=$P(XQY,",",XQI) Q:'XQX D
. I +XQX S XQK=$$GET1^DIQ(19,XQX,2) I XQK'="" S XQRT="1^"_XQK Q
Q XQRT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQCHK2 3253 printed Dec 13, 2024@02:05:35 Page 2
XQCHK2 ; OAK-BP/BDT - Internal APIs to check Keys for options; 4/28/11
+1 ;;8.0;KERNEL;**427,503,570**;Jul 10, 1995;Build 3
+2 ;;"Per VHA Directive 2004-038, this routine should not be modified".
+3 QUIT
+4 ;; These Internal Kernel APIs are using in the routine XQCHK
+5 ;; to check Keys for options
+6 ;;
CHCKL(XQCY0,XQDUZ) ;Entry point for checking all Locks for an option
+1 ;; XQCY0 is $P(^XUTL("XQO",XQDIC,"^",%XQOP),"^",2,99)
+2 ;; XQDUZ is IEN of user
+3 ;; Return XQRT: Zero or 1^Key found that user needed for the option
+4 SET XQCY0=$GET(XQCY0)
+5 NEW XQI,XQY,XQX,XQRT,XQK
SET (XQRT,XQX)=0
+6 ;check Key for the option; p457
+7 SET XQY=$PIECE(XQCY0,"^")
SET XQX=$$GETIEN(XQY)
+8 IF +XQX
SET XQK=$$GET1^DIQ(19,XQX,3)
+9 IF $GET(XQK)'=""
IF '$DATA(^XUSEC(XQK,XQDUZ))
SET XQRT=1_"^"_XQK
QUIT XQRT
+10 ;loop through higher menu options.
+11 SET XQY=$PIECE(XQCY0,"^",5)
+12 FOR XQI=1:1
SET XQX=$PIECE(XQY,",",XQI)
if 'XQX
QUIT
Begin DoDot:1
+13 IF +XQX
SET XQK=$$GET1^DIQ(19,XQX,3)
IF XQK'=""
IF '$DATA(^XUSEC(XQK,XQDUZ))
SET XQRT=1_"^"_XQK
QUIT
End DoDot:1
+14 QUIT XQRT
+15 ;
CHCKRL(XQCY0,XQDUZ) ;Entry point for checking all Reversed Locks for an option
+1 ;; XQCY0 is $P(^XUTL("XQO",XQDIC,"^",%XQOP),"^",2,99)
+2 ;; XQDUZ is IEN of user
+3 ;; Return XQRT: Zero or 1^Reversed Key found that user has
+4 SET XQCY0=$GET(XQCY0)
+5 NEW XQI,XQY,XQX,XQRT,XQK
SET (XQRT,XQX)=0
+6 ;check Reversed Key for the option; p457
+7 SET XQY=$PIECE(XQCY0,"^")
SET XQX=$$GETIEN(XQY)
+8 IF +XQX
SET XQK=$$GET1^DIQ(19,XQX,3.01)
+9 IF $GET(XQK)'=""
IF $DATA(^XUSEC(XQK,XQDUZ))
SET XQRT=1_"^"_XQK
QUIT XQRT
+10 ;loop through higher menu options.
+11 SET XQY=$PIECE(XQCY0,"^",5)
+12 FOR XQI=1:1
SET XQX=$PIECE(XQY,",",XQI)
if 'XQX
QUIT
Begin DoDot:1
+13 IF +XQX
SET XQK=$$GET1^DIQ(19,XQX,3.01)
IF XQK'=""
IF $DATA(^XUSEC(XQK,XQDUZ))
SET XQRT=1_"^"_XQK
QUIT
End DoDot:1
+14 QUIT XQRT
+15 ;
GETIEN(XQNAME) ;get IEN for an option; 457
+1 ;; XQNAME is name of an option
+2 ;; Retrun XQIEN: Null or IEN if existed
+3 NEW XQIEN
SET XQIEN=""
+4 IF $GET(XQNAME)=""
QUIT XQIEN
+5 IF '$DATA(^DIC(19,"B",XQNAME))
QUIT XQIEN
+6 SET XQIEN=$ORDER(^DIC(19,"B",XQNAME,XQIEN))
+7 QUIT XQIEN
+8 ;
CHKTOPL(XQIEN,XQDUZ) ;Check Lock for the top level of the secondary options
+1 ;this need to be called to check the top level first when check the
+2 ;Locks for lower menu option because the 6th piece of ^XUTL does not
+3 ;contain the IEN of the top menu option.
+4 NEW XQRT,XQK
SET XQRT=0
+5 IF XQIEN'=+$GET(XQIEN)
QUIT XQRT
+6 SET XQK=$$GET1^DIQ(19,XQIEN,3)
+7 IF $GET(XQK)'=""
IF '$DATA(^XUSEC(XQK,XQDUZ))
SET XQRT=1_"^"_XQK
+8 QUIT XQRT
+9 ;
CHKTOPRL(XQIEN,XQDUZ) ;Check Reversed Lock the top level of the secondary options
+1 ;this need to be called to check the top level first when check the
+2 ;Reversed Locks for lower menu option because the 6th piece of ^XUTL does not
+3 ;contain the IEN of the top menu option.
+4 NEW XQRT,XQK
SET XQRT=0
+5 IF XQIEN'=+$GET(XQIEN)
QUIT XQRT
+6 SET XQK=$$GET1^DIQ(19,XQIEN,3.01)
+7 IF $GET(XQK)'=""
IF $DATA(^XUSEC(XQK,XQDUZ))
SET XQRT=1_"^"_XQK
+8 QUIT XQRT
+9 ;
CHKOOO(XQCY0) ; Check OOO option
+1 ;; XQCY0 is $P(^XUTL("XQO",XQDIC,"^",%XQOP),"^",2,99)
+2 ;; Return XQRT: Zero or 1^Out Of Order message
+3 SET XQCY0=$GET(XQCY0)
+4 NEW XQI,XQY,XQX,XQRT,XQK
SET (XQRT,XQX)=0
+5 ;check Out Of Order
+6 SET XQY=$PIECE(XQCY0,"^")
SET XQX=$$GETIEN(XQY)
+7 IF +XQX
SET XQK=$$GET1^DIQ(19,XQX,2)
+8 IF $GET(XQK)'=""
QUIT "1^"_$GET(XQK)
+9 ;loop through higher menu options.
+10 SET XQY=$PIECE(XQCY0,"^",5)
+11 FOR XQI=1:1
SET XQX=$PIECE(XQY,",",XQI)
if 'XQX
QUIT
Begin DoDot:1
+12 IF +XQX
SET XQK=$$GET1^DIQ(19,XQX,2)
IF XQK'=""
SET XQRT="1^"_XQK
QUIT
End DoDot:1
+13 QUIT XQRT
+14 ;
