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 ---[H[J[2J[HRMPRSEC 1912 printed Nov 22, 2024@17:47:43 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
