- PRCASIG ;WASH-ISC@ALTOONA,PA/CMS-AR ELEC SIGNATURE CODE ;11/6/92 2:19 PM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN(X,X1,X2) ;Enter Electronic Signature Code.
- I '$D(X)!('$D(X1))!('$D(X2)) Q
- D EN^XUSHSHP
- Q
- DE(X,X1,X2) ;Display Electronic Signature Code.
- I '$D(X)!('$D(X1))!('$D(X2)) Q
- D DE^XUSHSHP
- Q
- SIG ;ask Electronic Signature Code and verify.
- K PRCANM Q:'DUZ!('$D(DA)) I $D(^VA(200,DUZ,20)),$P(^(20),U,4)]"" S PRCAKCT=0,PRCANM=$P(^(20),U,4) G SIG1
- W !?5,"Your Electronic Signature Code is undefined." K PRCAKCT Q
- SIG1 W !,"Enter Electronic Signature Code: " X ^%ZOSF("EOFF") R X:DTIME X ^%ZOSF("EON") G:$E(X)="^"!(X="")!('$T) SIGQ I X["?",$L(X)<6 D SIGH G SIG1
- S PRCAKCT=PRCAKCT+1 D HASH^XUSHSHP I X'=PRCANM G SIG1:PRCAKCT<3,SIGQ
- K PRCAKCT S P=DUZ,X=$S($D(^VA(200,P,20)):$P(^(20),U,2),1:"") G:X="" SIGQ
- D EN(.X,P,DA_$S($P($G(^PRCA(430,DA,0)),U,2)=$O(^PRCA(430.2,"AC",33,0)):+$P(^PRCA(430,DA,7),U,18),$P($G(^PRCA(430,DA,0)),U,3)>0:+$P(^PRCA(430,DA,0),U,3),1:"")) I X="" K PRCANM,P Q
- S PRCANM=X W " <Signature verified>" Q
- SIGQ W " <Signature Failed> ",*7 K PRCANM,PRCAKCT Q
- SIGH W !!,"Enter in your Electronic Signature Code, 6 to 20 characters.",! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCASIG 1262 printed Jan 18, 2025@02:42:34 Page 2
- PRCASIG ;WASH-ISC@ALTOONA,PA/CMS-AR ELEC SIGNATURE CODE ;11/6/92 2:19 PM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN(X,X1,X2) ;Enter Electronic Signature Code.
- +1 IF '$DATA(X)!('$DATA(X1))!('$DATA(X2))
- QUIT
- +2 DO EN^XUSHSHP
- +3 QUIT
- DE(X,X1,X2) ;Display Electronic Signature Code.
- +1 IF '$DATA(X)!('$DATA(X1))!('$DATA(X2))
- QUIT
- +2 DO DE^XUSHSHP
- +3 QUIT
- SIG ;ask Electronic Signature Code and verify.
- +1 KILL PRCANM
- if 'DUZ!('$DATA(DA))
- QUIT
- IF $DATA(^VA(200,DUZ,20))
- IF $PIECE(^(20),U,4)]""
- SET PRCAKCT=0
- SET PRCANM=$PIECE(^(20),U,4)
- GOTO SIG1
- +2 WRITE !?5,"Your Electronic Signature Code is undefined."
- KILL PRCAKCT
- QUIT
- SIG1 WRITE !,"Enter Electronic Signature Code: "
- XECUTE ^%ZOSF("EOFF")
- READ X:DTIME
- XECUTE ^%ZOSF("EON")
- if $EXTRACT(X)="^"!(X="")!('$TEST)
- GOTO SIGQ
- IF X["?"
- IF $LENGTH(X)<6
- DO SIGH
- GOTO SIG1
- +1 SET PRCAKCT=PRCAKCT+1
- DO HASH^XUSHSHP
- IF X'=PRCANM
- if PRCAKCT<3
- GOTO SIG1
- GOTO SIGQ
- +2 KILL PRCAKCT
- SET P=DUZ
- SET X=$SELECT($DATA(^VA(200,P,20)):$PIECE(^(20),U,2),1:"")
- if X=""
- GOTO SIGQ
- +3 DO EN(.X,P,DA_$SELECT($PIECE($GET(^PRCA(430,DA,0)),U,2)=$ORDER(^PRCA(430.2,"AC",33,0)):+$PIECE(^PRCA(430,DA,7),U,18),$PIECE($GET(^PRCA(430,DA,0)),U,3)>0:+$PIECE(^PRCA(430,DA,0),U,3),1:""))
- IF X=""
- KILL PRCANM,P
- QUIT
- +4 SET PRCANM=X
- WRITE " <Signature verified>"
- QUIT
- SIGQ WRITE " <Signature Failed> ",*7
- KILL PRCANM,PRCAKCT
- QUIT
- SIGH WRITE !!,"Enter in your Electronic Signature Code, 6 to 20 characters.",!
- QUIT