PRSAES ; HISC/REL-Electronic Signature ;3/20/92 15:54
;;4.0;PAID;**100**;Sep 21, 1995;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified.
S ES=$P($G(^VA(200,DUZ,20)),"^",4),ESNAM=$P($G(^(20)),"^",2),ESCNT=0
I ES="" W !!,"No electronic signature on file!" G E2
I ESNAM="" W !!,"No electronic signature block on file!" G E2
E1 W !!,"Enter Signature Code: " X ^%ZOSF("EOFF") R X:60 X ^%ZOSF("EON") S:'$T X="^" I X=""!(X="^") G E2
I X="?"!(X="??") W !,"Enter your Electronic Signature code to verify this action." G E1
S ESCNT=ESCNT+1 D HASH^XUSHSHP I ES'=X W " ??",*7 S X="" G E1:ESCNT<3,E2
W " ... signed." S ESOK=1 K X,ES,ESCNT Q
E2 S ESOK=0 W *7," ... Not Signed." K X,ES,ESCNT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAES 726 printed Dec 13, 2024@02:23:30 Page 2
PRSAES ; HISC/REL-Electronic Signature ;3/20/92 15:54
+1 ;;4.0;PAID;**100**;Sep 21, 1995;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET ES=$PIECE($GET(^VA(200,DUZ,20)),"^",4)
SET ESNAM=$PIECE($GET(^(20)),"^",2)
SET ESCNT=0
+4 IF ES=""
WRITE !!,"No electronic signature on file!"
GOTO E2
+5 IF ESNAM=""
WRITE !!,"No electronic signature block on file!"
GOTO E2
E1 WRITE !!,"Enter Signature Code: "
XECUTE ^%ZOSF("EOFF")
READ X:60
XECUTE ^%ZOSF("EON")
if '$TEST
SET X="^"
IF X=""!(X="^")
GOTO E2
+1 IF X="?"!(X="??")
WRITE !,"Enter your Electronic Signature code to verify this action."
GOTO E1
+2 SET ESCNT=ESCNT+1
DO HASH^XUSHSHP
IF ES'=X
WRITE " ??",*7
SET X=""
if ESCNT<3
GOTO E1
GOTO E2
+3 WRITE " ... signed."
SET ESOK=1
KILL X,ES,ESCNT
QUIT
E2 SET ESOK=0
WRITE *7," ... Not Signed."
KILL X,ES,ESCNT
QUIT
