source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUESIG.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1PRCUESIG ;WISC@ALTOONA/CTB/TEN-ROUTINE TO ENTER OR CHANGE ELECTRONIC SIGNATURE CODE (IFCAP) ;5/4/93 8:31 AM
2V ;;5.1;IFCAP;**68**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4ENCODE(X,X1,X2) D EN^XUSHSHP Q X
5DECODE(X,X1,X2) D DE^XUSHSHP Q X
6HASH(X) D HASH^XUSHSHP Q X
7SUM(X) ;CREATE CHECKSUM VALUE FOR STRING
8 N I,Y
9 S Y=0 F I=1:1:$L(X) S Y=$A(X,I)*I+Y
10 Q Y
11ESIG(USERNUM,MESSAGE) ;interogate user for electronic signature code
12 ;1= valid code entered
13 ;0= invalid code entered
14 ;-1= user up arrowed out
15 ;-2= signature read time out
16 ;-3= no signature on file
17 NEW X,SIGCODE,ZZI,OUT
18 I $G(PRCRMPR) S MESSAGE=1 Q
19 S SIGCODE=$P($G(^VA(200,USERNUM,20)),"^",4)
20 I SIGCODE="" W !,"You have no signature code on file. Please contact your IRM staff for assistance.",$C(7),! S MESSAGE=-3 QUIT
21 F ZZI=1:1:3 D Q:OUT]""
22 . K OUT
23 . W !,"Enter ELECTRONIC SIGNATURE CODE: "
24 . X ^%ZOSF("EOFF") R X:60 X ^%ZOSF("EON")
25 . I '$T S OUT=-2 QUIT
26 . I $E(X)="^" S OUT=-1 QUIT
27 . S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
28 . I $$HASH(X)=SIGCODE W ?60,"Thank you." S OUT=1 QUIT
29 . W !,"Sorry, but that's not your correct electronic signature code."
30 . S OUT=""
31 . QUIT
32 S MESSAGE=+$G(OUT)
33 Q
34 ;
35NOW() ;Extrinsic function to return current time
36 N %,%I,%H,X
37 D NOW^%DTC
38 QUIT %
39 ;
Note: See TracBrowser for help on using the repository browser.