PRCUESIG ;WISC@ALTOONA/CTB/TEN-ROUTINE TO ENTER OR CHANGE ELECTRONIC SIGNATURE CODE (IFCAP) ;5/4/93 8:31 AM
V ;;5.1;IFCAP;**68**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
ENCODE(X,X1,X2) D EN^XUSHSHP Q X
DECODE(X,X1,X2) D DE^XUSHSHP Q X
HASH(X) D HASH^XUSHSHP Q X
SUM(X) ;CREATE CHECKSUM VALUE FOR STRING
N I,Y
S Y=0 F I=1:1:$L(X) S Y=$A(X,I)*I+Y
Q Y
ESIG(USERNUM,MESSAGE) ;interogate user for electronic signature code
;1= valid code entered
;0= invalid code entered
;-1= user up arrowed out
;-2= signature read time out
;-3= no signature on file
NEW X,SIGCODE,ZZI,OUT
I $G(PRCRMPR) S MESSAGE=1 Q
S SIGCODE=$P($G(^VA(200,USERNUM,20)),"^",4)
I SIGCODE="" W !,"You have no signature code on file. Please contact your IRM staff for assistance.",$C(7),! S MESSAGE=-3 QUIT
F ZZI=1:1:3 D Q:OUT]""
. K OUT
. W !,"Enter ELECTRONIC SIGNATURE CODE: "
. X ^%ZOSF("EOFF") R X:60 X ^%ZOSF("EON")
. I '$T S OUT=-2 QUIT
. I $E(X)="^" S OUT=-1 QUIT
. S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. I $$HASH(X)=SIGCODE W ?60,"Thank you." S OUT=1 QUIT
. W !,"Sorry, but that's not your correct electronic signature code."
. S OUT=""
. QUIT
S MESSAGE=+$G(OUT)
Q
;
NOW() ;Extrinsic function to return current time
N %,%I,%H,X
D NOW^%DTC
QUIT %
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCUESIG 1362 printed Oct 16, 2024@18:20:19 Page 2
PRCUESIG ;WISC@ALTOONA/CTB/TEN-ROUTINE TO ENTER OR CHANGE ELECTRONIC SIGNATURE CODE (IFCAP) ;5/4/93 8:31 AM
V ;;5.1;IFCAP;**68**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
ENCODE(X,X1,X2) DO EN^XUSHSHP
QUIT X
DECODE(X,X1,X2) DO DE^XUSHSHP
QUIT X
HASH(X) DO HASH^XUSHSHP
QUIT X
SUM(X) ;CREATE CHECKSUM VALUE FOR STRING
+1 NEW I,Y
+2 SET Y=0
FOR I=1:1:$LENGTH(X)
SET Y=$ASCII(X,I)*I+Y
+3 QUIT Y
ESIG(USERNUM,MESSAGE) ;interogate user for electronic signature code
+1 ;1= valid code entered
+2 ;0= invalid code entered
+3 ;-1= user up arrowed out
+4 ;-2= signature read time out
+5 ;-3= no signature on file
+6 NEW X,SIGCODE,ZZI,OUT
+7 IF $GET(PRCRMPR)
SET MESSAGE=1
QUIT
+8 SET SIGCODE=$PIECE($GET(^VA(200,USERNUM,20)),"^",4)
+9 IF SIGCODE=""
WRITE !,"You have no signature code on file. Please contact your IRM staff for assistance.",$CHAR(7),!
SET MESSAGE=-3
QUIT
+10 FOR ZZI=1:1:3
Begin DoDot:1
+11 KILL OUT
+12 WRITE !,"Enter ELECTRONIC SIGNATURE CODE: "
+13 XECUTE ^%ZOSF("EOFF")
READ X:60
XECUTE ^%ZOSF("EON")
+14 IF '$TEST
SET OUT=-2
QUIT
+15 IF $EXTRACT(X)="^"
SET OUT=-1
QUIT
+16 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+17 IF $$HASH(X)=SIGCODE
WRITE ?60,"Thank you."
SET OUT=1
QUIT
+18 WRITE !,"Sorry, but that's not your correct electronic signature code."
+19 SET OUT=""
+20 QUIT
End DoDot:1
if OUT]""
QUIT
+21 SET MESSAGE=+$GET(OUT)
+22 QUIT
+23 ;
NOW() ;Extrinsic function to return current time
+1 NEW %,%I,%H,X
+2 DO NOW^%DTC
+3 QUIT %
+4 ;
