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