PRPFSIG ;WISC@ALTOONA/CTB/TEN-ROUTINE TO ENTER OR CHANGE ELECTRONIC SIGNATURE CODE ;7/15/97 9:56 AM
V ;;3.0;PATIENT FUNDS;**6,7**;JUNE 1, 1989
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
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.",*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) QUIT
;
NOW() ;Extrinsic function to return current time
N %,%I,%H,X
D NOW^%DTC
QUIT %
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFSIG 1258 printed Nov 22, 2024@17:12:07 Page 2
PRPFSIG ;WISC@ALTOONA/CTB/TEN-ROUTINE TO ENTER OR CHANGE ELECTRONIC SIGNATURE CODE ;7/15/97 9:56 AM
V ;;3.0;PATIENT FUNDS;**6,7**;JUNE 1, 1989
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 SET SIGCODE=$PIECE($GET(^VA(200,USERNUM,20)),"^",4)
+8 IF SIGCODE=""
WRITE !,"You have no signature code on file. Please contact your IRM staff for assistance.",*7,!
SET MESSAGE=-3
QUIT
+9 FOR ZZI=1:1:3
Begin DoDot:1
+10 KILL OUT
+11 WRITE !,"Enter ELECTRONIC SIGNATURE CODE: "
+12 XECUTE ^%ZOSF("EOFF")
READ X:60
XECUTE ^%ZOSF("EON")
+13 IF '$TEST
SET OUT=-2
QUIT
+14 IF $EXTRACT(X)="^"
SET OUT=-1
QUIT
+15 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+16 IF $$HASH(X)=SIGCODE
WRITE ?60,"Thank you."
SET OUT=1
QUIT
+17 WRITE !,"Sorry, but that's not your correct electronic signature code."
+18 SET OUT=""
+19 QUIT
End DoDot:1
if OUT]""
QUIT
+20 SET MESSAGE=+$GET(OUT)
QUIT
+21 ;
NOW() ;Extrinsic function to return current time
+1 NEW %,%I,%H,X
+2 DO NOW^%DTC
+3 QUIT %
