XUSESIG2.m

XUSESIG2 ;EPIP/LLB - ROUTINE TO ENTER OR CHNAGE ELECTRONIC SIGNATURE REVISED; 10 Feb 2017  11:15 AM ; 09 Mar 2017  10:09 AM

 ;;8.0;KERNEL;**679**;02/02/2017;Build 27

 ;

 ; ^XUSEC(KEY,DUZ) is supported by ICR #10076

 ;

 Q  ;Must be called from a tag.

 ; Function to test if patch XU*8.0*679 is active and if the user has the proper credentials

 ; to edit field 10.6 (Degree) in the NEW PERSON file (#200).

EN ;

 I '$G(DUZ) W "USER NOT SIGNED IN" Q  ; Test if user is signed in

 ; Test if the system parameter "Electronic Signature Block Edit" is on

 ;

 S DA=DUZ

 ; If the switch is ON then check user and is security key XUSIG is present.

 ; $$GET^XPAR does not error if the system parameter does not exist. Returns null

 I '$$GET^XPAR("ALL","XU SIG BLOCK DISABLE") D

 . N DIC K DIC

 . S DIC="^VA(200,",DIC(0)="AEMQ"

 . D ^DIC S DA=+Y

 . S DIE=DIC K DIC S DR="20.2;10.6" D ^DIE

 E  D  ; Get person to lookup and check for security key.

 . N DIC,DIR

 . ;check for security key. If not present denie access and quit.

 . I '$D(^XUSEC("XUSIG",DUZ)) D  Q

 . . ;W !,"Edit Access Denied. Press <ENTER> to Continue. "

 . . S DIR(0)="FO^1",DIR("A")="Edit Access Denied. Contact your CAC/ADPAC for assistance. Press <ENTER> to Continue. "

 . . D ^DIR K DIR

 . K DIC

 . S DIC="^VA(200,",DIC(0)="QEAL",DIC("A")="Enter Person to Edit: "

 . D ^DIC

 . K DIC

 . S DA=+Y

 . D PNM^XUSESIG3 ; Edit Signature Block Printed Name & Title

 . D DEGREE^XUSESIG3 ; Edit DEGREE field in NEW PERSON (#200) file

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XUSESIG2   1524     printed  Apr 09, 2024@21:16:38                                                                                                                                                                                                    Page 2

XUSESIG2  ;EPIP/LLB - ROUTINE TO ENTER OR CHNAGE ELECTRONIC SIGNATURE REVISED; 10 Feb 2017  11:15 AM ; 09 Mar 2017  10:09 AM

 +1       ;;8.0;KERNEL;**679**;02/02/2017;Build 27

 +2       ;

 +3       ; ^XUSEC(KEY,DUZ) is supported by ICR #10076

 +4       ;

 +5       ;Must be called from a tag.

           QUIT 

 +6       ; Function to test if patch XU*8.0*679 is active and if the user has the proper credentials

 +7       ; to edit field 10.6 (Degree) in the NEW PERSON file (#200).

EN        ;

 +1       ; Test if user is signed in

           IF '$GET(DUZ)

               WRITE "USER NOT SIGNED IN"

               QUIT 

 +2       ; Test if the system parameter "Electronic Signature Block Edit" is on

 +3       ;

 +4        SET DA=DUZ

 +5       ; If the switch is ON then check user and is security key XUSIG is present.

 +6       ; $$GET^XPAR does not error if the system parameter does not exist. Returns null

 +7        IF '$$GET^XPAR("ALL","XU SIG BLOCK DISABLE")

               Begin DoDot:1

 +8                NEW DIC

                   KILL DIC

 +9                SET DIC="^VA(200,"

                   SET DIC(0)="AEMQ"

 +10               DO ^DIC

                   SET DA=+Y

 +11               SET DIE=DIC

                   KILL DIC

                   SET DR="20.2;10.6"

                   DO ^DIE

               End DoDot:1

 +12      ; Get person to lookup and check for security key.

          IF '$TEST

               Begin DoDot:1

 +13               NEW DIC,DIR

 +14      ;check for security key. If not present denie access and quit.

 +15               IF '$DATA(^XUSEC("XUSIG",DUZ))

                       Begin DoDot:2

 +16      ;W !,"Edit Access Denied. Press <ENTER> to Continue. "

 +17                       SET DIR(0)="FO^1"

                           SET DIR("A")="Edit Access Denied. Contact your CAC/ADPAC for assistance. Press <ENTER> to Continue. "

 +18                       DO ^DIR

                           KILL DIR

                       End DoDot:2

                       QUIT 

 +19               KILL DIC

 +20               SET DIC="^VA(200,"

                   SET DIC(0)="QEAL"

                   SET DIC("A")="Enter Person to Edit: "

 +21               DO ^DIC

 +22               KILL DIC

 +23               SET DA=+Y

 +24      ; Edit Signature Block Printed Name & Title

                   DO PNM^XUSESIG3

 +25      ; Edit DEGREE field in NEW PERSON (#200) file

                   DO DEGREE^XUSESIG3

               End DoDot:1

 +26       QUIT 

 +27      ;