source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFES1.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PRCFES1 ;WISC@ALTOONA/CTB/PLT-ESIG MAINTENANCE ROUTINE ;5/20/93 9:35 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;ROUTINE FOR MAINTAINING FIELD 999.3 (ELECTRONIC SIGNATURE), FILE 423
5DECODE(LEVEL0) ;Extrinsic Function to return hashed electronic sig to readable form.
6 ;returns "" if unsuccessful
7 NEW RECORD,RECORD8,RECORD81,RECCODE,VERSION,PERSON,SIG,CHECKSUM
8 ;get record and check version
9 S RECORD=$G(^PRCF(423,LEVEL0,0)) I RECORD="" QUIT ""
10 S RECORD8=$G(^PRCF(423,LEVEL0,8))
11 S RECORD81=$G(^PRCF(423,LEVEL0,8.1))
12 S RECCODE=$G(^PRCF(423,LEVEL0,"CODE"))
13 S VERSION=$P(RECORD81,"^",1)
14 S PERSON=+$P(RECORD,"^",8)
15 I VERSION'="",VERSION'=1 Q ""
16 S SIG=$P(RECORD8,"^",16)
17D1 ;decode e signature for version 1
18 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_$$STRING(RECCODE,RECORD81))
19 QUIT $$DECODE^PRCUESIG(SIG,PERSON,CHECKSUM)
20ENCODE(LEVEL0,USERNUM,Y) ;Encode e signature for version 1 only
21 ;Parameter passing entry point
22 NEW RECORD,RECORDE8,RECORD81,RECCODE,SIGBLOCK,CHECKSUM,OLDUSER
23 ;get record
24 S USERNUM=+USERNUM
25 I USERNUM=0 S Y=-3 QUIT ;-3 no user num available
26 S SIGBLOCK=$P($G(^VA(200,USERNUM,20)),"^",2)
27 I SIGBLOCK="" S Y=-2 QUIT ;-2 no sigblock in file 200
28 S RECORD=$G(^PRCF(423,LEVEL0,0))
29 S RECORD8=$G(^PRCF(423,LEVEL0,8))
30 S RECORD81=$G(^PRCF(423,LEVEL0,8.1))
31 S RECCODE=$G(^PRCF(423,LEVEL0,"CODE"))
32 I RECORD="" S Y=-1 QUIT ;-1 no 2237 record
33 I $P(RECORD8,"^",16)'="" S Y=-4 QUIT ;-4 cannot re-sign record
34 S OLDUSER=+$P(RECORD,"^",8)
35 I OLDUSER=0 S $P(RECORD,"^",8)=USERNUM
36 I OLDUSER>0 S USERNUM=OLDUSER
37 S:$P(RECORD81,"^",2)="" $P(RECORD81,"^",2)=$$NOW^PRCUESIG
38 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_$$STRING(RECCODE,RECORD81))
39 S $P(RECORD8,"^",16)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)
40 S $P(RECORD81,"^",1)=1,$P(RECORD81,"^",3)=$$SUM^PRCUESIG(SIGBLOCK)
41 S ^PRCF(423,LEVEL0,0)=RECORD
42 S ^PRCF(423,LEVEL0,8)=RECORD8
43 S ^PRCF(423,LEVEL0,8.1)=RECORD81
44 S Y=1 QUIT
45REMOVE(LEVEL0) ;Entry point to remove e signature from record
46 ;NOT an extrinsic function
47 NEW I,RECORD8,RECORD81
48 S RECORD=$G(^PRCF(423,LEVEL0,0))
49 S RECORD8=$G(^PRCF(423,LEVEL0,8))
50 S RECORD81=$G(^PRCF(423,LEVEL0,8.1))
51 S $P(RECORD,"^",8)=""
52 S $P(RECORD8,"^",16)=""
53 S $P(RECORD81,"^",2,3)="^"
54 S ^PRCF(423,LEVEL0,0)=RECORD
55 S ^PRCF(423,LEVEL0,8)=RECORD8
56 S ^PRCF(423,LEVEL0,8.1)=RECORD81
57 QUIT
58VERIFY(LEVEL0) ;extrinsic function to verify version 1 signature. Returns 1 if valid, 0 if not valid
59 NEW RECORD81,VERSION,SIGBLOCK
60 ;get record variables
61 S RECORD81=$G(^PRCF(423,LEVEL0,8.1))
62 S VERSION=$P(RECORD81,"^",1),SIGBLOCK=$P(RECORD81,"^",3)
63 I VERSION_SIGBLOCK="" QUIT 1
64 QUIT ($$SUM^PRCUESIG($$DECODE(LEVEL0))=SIGBLOCK)
65STRING(X,X81) ;Build String of critical fields
66 Q X_"^"_$P(X81,"^",2)
Note: See TracBrowser for help on using the repository browser.