RMPRSEC.m

RMPRSEC ;PHX/JLT-PROSTHETICS SECURITY CHECK ;10/01/1994

 ;;3.0;PROSTHETICS;;Feb 09, 1996

RO ;REQUESTING OFFICAL SIGNATURE

 S X1="" K DIR S DIR(0)="F^1:30",DIR("A")="Electronic Signature Code of Requesting Official" G SIG

AP ;APPROVING OFFICIAL SIGNATURE

 ;VARIABLE REQUIRED - DUZ

 S X1="" K DIR S DIR(0)="FO^1:30",DIR("A")="Electronic Signature Code of Approving Official" D SIG Q  ;K ^RMPR(664,"AP",RMPR("SITE"),

IP ;INSPECTING OFFICIAL SIGNATURE

 S X1="" K DIR S DIR(0)="F^1:30",DIR("A")="Electronic Signature Code of Inspecting Official" G SIG

EX ;COLLECT SIGNATURE OF EXAMINER

 ;CALLED BY RMPREYC

 ;VARIABLE REQUIRED - DUZ

 S X1="" K DIR S DIR(0)="F^1:30",DIR("A")="Electronic Signature Code of Examiner"

SIG S RMPRC=0

CHK S X1=$S($D(^VA(200,+$G(DUZ),20))[0:"",1:$P(^(20),"^",4),1:"") I X1="" W !!,$C(7),?5,"YOU DO NOT HAVE AN ELECTRONIC SIGNATURE CODE.",!,?5,"USE THE TBOX OPTION TO ENTER OR CHANGE YOUR SIGNATURE CODE" Q

 X ^%ZOSF("EOFF") D WRT D ^DIR X ^%ZOSF("EON")

 S RMPRX=X W:RMPRX="^"!(X["?") RMPRX

 Q:RMPRX="^"

 W:$D(DIRUT) !!,?5,$C(7),"This document must be signed for Authentication Purposes!!" K X1 Q:$D(DIRUT)

 I RMPRC>2 W !!,$C(7),?5,"Use the TBOX option to change your Electronic Signature code." Q

 D HASH^XUSHSHP I $P(^VA(200,DUZ,20),U,4)'=X W !!,$C(7),?5,"**That is not your Electronic Signature Code.  Try again**",!! S RMPRC=RMPRC+1 G CHK

 S RMPRSBP=$P(^VA(200,DUZ,20),U,2),RMPRSBT=$P(^(20),U,3),X1=X W !!,?5,$C(7),"Signature Code verified!" Q

ENCODE(X,X1,X2) ;ENCRYPT ELECTRONIC SIGNATURE

 D EN^XUSHSHP Q X

DECODE(X,X1,X2) ;DECRYPT ELECTRONIC SIGNATURE

 D DE^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

WRT ;WRITE HELP SCREENS FOR ELECTRONIC SIGNATURE PROMPTS

 S DIR("?")="YOU MUST ENTER YOUR CORRECT ELECTRONIC SIGNATURE CODE TO ACCOMPLISH THE ACTION"

 S DIR("??")="RMPR-ELECTRONIC SIGNATURE" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRSEC   1912     printed  Apr 09, 2024@21:34:14                                                                                                                                                                                                     Page 2

RMPRSEC   ;PHX/JLT-PROSTHETICS SECURITY CHECK ;10/01/1994

 +1       ;;3.0;PROSTHETICS;;Feb 09, 1996

RO        ;REQUESTING OFFICAL SIGNATURE

 +1        SET X1=""

           KILL DIR

           SET DIR(0)="F^1:30"

           SET DIR("A")="Electronic Signature Code of Requesting Official"

           GOTO SIG

AP        ;APPROVING OFFICIAL SIGNATURE

 +1       ;VARIABLE REQUIRED - DUZ

 +2       ;K ^RMPR(664,"AP",RMPR("SITE"),

           SET X1=""

           KILL DIR

           SET DIR(0)="FO^1:30"

           SET DIR("A")="Electronic Signature Code of Approving Official"

           DO SIG

           QUIT 

IP        ;INSPECTING OFFICIAL SIGNATURE

 +1        SET X1=""

           KILL DIR

           SET DIR(0)="F^1:30"

           SET DIR("A")="Electronic Signature Code of Inspecting Official"

           GOTO SIG

EX        ;COLLECT SIGNATURE OF EXAMINER

 +1       ;CALLED BY RMPREYC

 +2       ;VARIABLE REQUIRED - DUZ

 +3        SET X1=""

           KILL DIR

           SET DIR(0)="F^1:30"

           SET DIR("A")="Electronic Signature Code of Examiner"

SIG        SET RMPRC=0

CHK        SET X1=$SELECT($DATA(^VA(200,+$GET(DUZ),20))[0:"",1:$PIECE(^(20),"^",4),1:"")

           IF X1=""

               WRITE !!,$CHAR(7),?5,"YOU DO NOT HAVE AN ELECTRONIC SIGNATURE CODE.",!,?5,"USE THE TBOX OPTION TO ENTER OR CHANGE YOUR SIGNATURE CODE"

               QUIT 

 +1        XECUTE ^%ZOSF("EOFF")

           DO WRT

           DO ^DIR

           XECUTE ^%ZOSF("EON")

 +2        SET RMPRX=X

           if RMPRX="^"!(X["?")

               WRITE RMPRX

 +3        if RMPRX="^"

               QUIT 

 +4        if $DATA(DIRUT)

               WRITE !!,?5,$CHAR(7),"This document must be signed for Authentication Purposes!!"

           KILL X1

           if $DATA(DIRUT)

               QUIT 

 +5        IF RMPRC>2

               WRITE !!,$CHAR(7),?5,"Use the TBOX option to change your Electronic Signature code."

               QUIT 

 +6        DO HASH^XUSHSHP

           IF $PIECE(^VA(200,DUZ,20),U,4)'=X

               WRITE !!,$CHAR(7),?5,"**That is not your Electronic Signature Code.  Try again**",!!

               SET RMPRC=RMPRC+1

               GOTO CHK

 +7        SET RMPRSBP=$PIECE(^VA(200,DUZ,20),U,2)

           SET RMPRSBT=$PIECE(^(20),U,3)

           SET X1=X

           WRITE !!,?5,$CHAR(7),"Signature Code verified!"

           QUIT 

ENCODE(X,X1,X2) ;ENCRYPT ELECTRONIC SIGNATURE

 +1        DO EN^XUSHSHP

           QUIT X

DECODE(X,X1,X2) ;DECRYPT ELECTRONIC SIGNATURE

 +1        DO DE^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

WRT       ;WRITE HELP SCREENS FOR ELECTRONIC SIGNATURE PROMPTS

 +1        SET DIR("?")="YOU MUST ENTER YOUR CORRECT ELECTRONIC SIGNATURE CODE TO ACCOMPLISH THE ACTION"

 +2        SET DIR("??")="RMPR-ELECTRONIC SIGNATURE"

           QUIT