- 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 Jan 18, 2025@03:20:46 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 ;