| 1 | XUSESIG ;SF/RWF - ROUTINE TO ENTER OR CHANGE ELECTRONIC SIGNATURE CODE ;10/16/2006
|
|---|
| 2 | ;;8.0;KERNEL;**14,55,437**;Jul 10, 1995;Build 2
|
|---|
| 3 | A ;Called by others from the top. See DBIC #936
|
|---|
| 4 | I $D(DUZ)[0 W "NO ACTION CAN BE TAKEN ON YOUR REQUEST " Q
|
|---|
| 5 | N DA,DIE,DR,X1,K
|
|---|
| 6 | S DA=+DUZ S:$D(^VA(200,DA,0))[0 DA=0
|
|---|
| 7 | I DA'>0 W !,"You don't have an entry in the NEW PERSON file, See your site manager" G OUT
|
|---|
| 8 | W !,"This option is designed to permit you to enter or change your Initials,"
|
|---|
| 9 | W !,"Signature Block Information, Office Phone number, and Voice and",!,"Digital Pagers numbers."
|
|---|
| 10 | W !,"In addition, you are permitted to enter a new Electronic Signature Code"
|
|---|
| 11 | W !,"or to change an existing code."
|
|---|
| 12 | W !! S DIE="^VA(200,",DR="1;20.2;20.3;.132;.137;.138" D ^DIE
|
|---|
| 13 | I $P($G(^VA(200,DA,20)),U,2)="" W !,"You must have a SIGNATURE BLOCK PRINTED NAME before you can have",!,"an ELECTRONIC SIGNATURE CODE." G OUT1
|
|---|
| 14 | S X1=$P($G(^VA(200,DA,20)),"^",4) I X1]"" S K=0 D S2 G:X1="" OUT1
|
|---|
| 15 | S X1=$$NEW() W !,$S(X1:"DONE",1:" OPTION ABORTED."_$C(7))
|
|---|
| 16 | G OUT1
|
|---|
| 17 | ;
|
|---|
| 18 | NEW() ;Enter a NEW E-Sig code, return 0 for fail, 1 if done, 2 skip.
|
|---|
| 19 | N K,X,X1 S K=0
|
|---|
| 20 | W !!,"Your typing will not show."
|
|---|
| 21 | N2 W !,"ENTER NEW SIGNATURE CODE: " D R Q:X=""!(X="^") 2
|
|---|
| 22 | I X'?.UNP!($L(X)>20)!($L(X)<6) W *7,!,"Signature code must be 6 to 20 characters in length",!," With no control or lowercase characters.",! G N2
|
|---|
| 23 | S X1=X W !,"RE-ENTER SIGNATURE CODE FOR VERIFICATION: " D R G:X=""!(X="^") N5
|
|---|
| 24 | I X'=X1 W " CODE NOT VERIFIED, TRY AGAIN.",*7,! S K=K+1 G N5:K>3 G N2
|
|---|
| 25 | D HASH^XUSHSHP
|
|---|
| 26 | I X=$P(^VA(200,DA,20),U,4) W *7,!,"You can't use the same one.",! G N2
|
|---|
| 27 | S $P(^VA(200,DA,20),"^",4)=X
|
|---|
| 28 | F XUS=0:0 S XUS=$O(^DD(200,20.4,1,XUS)) Q:XUS'>0 X ^(XUS,1)
|
|---|
| 29 | N4 Q 1 ;OK
|
|---|
| 30 | N5 Q 0 ;FAIL
|
|---|
| 31 | ;
|
|---|
| 32 | R X ^%ZOSF("EOFF") R X:60 X ^%ZOSF("EON") S:'$T X="^" Q
|
|---|
| 33 | ;
|
|---|
| 34 | OUT W !," OPTION ABORTED.",*7
|
|---|
| 35 | OUT1 K %,D,D0,DA,DIC,DIE,DQ,DR,X,X1,A,K,I,Z Q
|
|---|
| 36 | ;
|
|---|
| 37 | SIG ;Call with DUZ; Return X1="" if fail else hashed ESC.
|
|---|
| 38 | N X2,K
|
|---|
| 39 | S X2=$G(^VA(200,+$G(DUZ),20)),X1=$P(X2,U,4) I X1="" W !,"No Electronic Signature code to check." Q
|
|---|
| 40 | S K=0 D S2 Q:X1=""
|
|---|
| 41 | Q ;Following code was to force code change
|
|---|
| 42 | N LIFE S LIFE=$$KSP^XUPARAM("LIFETIME")
|
|---|
| 43 | S X2=+X2 I X2>0,(X2+LIFE)'>(+$H) D I X1="" W !,*7,"Verification with held untill new code entered.",!
|
|---|
| 44 | . W !!,"Your Electronic Signature Code has expired, you need to create a new one."
|
|---|
| 45 | . N DA S DA=DUZ S:$$NEW()'=1 X1=""
|
|---|
| 46 | . Q
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | S2 W !!,"Enter your Current Signature Code: " D R G:X=""!(X="^") S9
|
|---|
| 50 | I X?1.2"?" W !,"Enter your current Electronic Signature Code so it can be verified.",! G S2
|
|---|
| 51 | S K=K+1 D HASH^XUSHSHP I X1'=X W " ??",*7 S X="" G S2:K<3,S9
|
|---|
| 52 | W " SIGNATURE VERIFIED"
|
|---|
| 53 | S9 S:X=""!(X="^") X1=""
|
|---|
| 54 | Q
|
|---|
| 55 | TEXT ;;
|
|---|
| 56 | CLEAR ;Clear (delete) a users ESC to allow entering a new one.
|
|---|
| 57 | S DIC=200,DIC(0)="AEMQ" D ^DIC G OUT:Y'>0 S DA=+Y,DIR(0)="Y"
|
|---|
| 58 | W !,"Clear SIGNATURE CODE from user ",$P(Y,U,2) D ^DIR G OUT1:Y'=1
|
|---|
| 59 | S DIE=DIC,DR="20.4///@" D ^DIE G OUT1
|
|---|
| 60 | Q
|
|---|
| 61 | ;;
|
|---|
