PRCASIG.m

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 ---PRCASIG   1262     printed  Apr 09, 2024@20:54:37                                                                                                                                                                                                     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