XQCHK2.m

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 ---XQCHK2   3253     printed  Mar 13, 2025@21:10:29                                                                                                                                                                                                      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      ;