source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCBES1.m@ 1780

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRCBES1 ;WISC@ALTOONA/CTB-ESIG MAINTENANCE ROUTINE ;1/15/95 12:28
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 12.5 (ELECTRONIC SIGNATURE), FILE 421
5DECODE(LEVEL0) ;Extrinsic Function to return hashed electronic sig to readable form.
6 ;returns "" if unsuccessful
7 NEW RECORD,RECORD4,VERSION,PERSON,SIG,CHECKSUM
8 ;get record and check version
9 S RECORD=$G(^PRCF(421,LEVEL0,0)) I RECORD="" QUIT ""
10 S RECORD4=$G(^PRCF(421,LEVEL0,4))
11 S VERSION=$P(RECORD4,"^",11)
12 S PERSON=+$P(RECORD,"^",11)
13 I VERSION'="",VERSION'=1 Q ""
14 S SIG=$P(RECORD,"^",17)
15 I VERSION=1 G D1
16D ;decode e signature less than version 1
17 S X=$$DECODE^PRCUESIG(SIG,LEVEL0,PERSON)
18 QUIT X
19D1 ;decode e signature for version 1
20 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_$$STRING(RECORD,RECORD4))
21 QUIT $$DECODE^PRCUESIG(SIG,PERSON,CHECKSUM)
22ENCODE(LEVEL0,USERNUM,Y) ;Encode e signature for version 1 only
23 ;Parameter passing entry point
24 NEW RECORD,RECORD4,SIGBLOCK,CHECKSUM,OLDUSER
25 ;get record
26 S USERNUM=+USERNUM
27 I USERNUM=0 S Y=-3 QUIT ;-3 no user num available
28 S SIGBLOCK=$P($G(^VA(200,USERNUM,20)),"^",2)
29 I SIGBLOCK="" S Y=-2 QUIT ;-2 no sigblock in file 200
30 S RECORD=$G(^PRCF(421,LEVEL0,0))
31 S RECORD4=$G(^PRCF(421,LEVEL0,4))
32 I RECORD="" S Y=-1 QUIT ;-1 no 2237 record
33 I $P(RECORD,"^",17)'="" S Y=-4 QUIT ;-4 cannot re-sign record
34 S OLDUSER=+$P(RECORD,"^",11)
35 I OLDUSER=0 S $P(RECORD,"^",11)=USERNUM
36 I OLDUSER>0 S USERNUM=OLDUSER
37 S:$P(RECORD4,"^",13)="" $P(RECORD4,"^",13)=$$NOW^PRCUESIG
38 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_$$STRING(RECORD,RECORD4))
39 S $P(RECORD,"^",17)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)
40 S $P(RECORD4,"^",11,12)="1^"_$$SUM^PRCUESIG(SIGBLOCK)
41 S ^PRCF(421,LEVEL0,0)=RECORD
42 S ^PRCF(421,LEVEL0,4)=RECORD4
43 S Y=1 QUIT
44REMOVE(LEVEL0) ;Entry point to remove e signature from record
45 ;NOT an extrinsic function
46 NEW I,RECORD,RECORD4
47 S RECORD4=$G(^PRCF(421,LEVEL0,4))
48 S RECORD=$G(^PRCF(421,LEVEL0,0))
49 F I=11,17 S $P(RECORD,"^",I)=""
50 S $P(RECORD4,"^",12,13)="^"
51 S ^PRCF(421,LEVEL0,1)=RECORD1
52 S ^PRCF(421,LEVEL0,4)=RECORD4
53 QUIT
54VERIFY(LEVEL0) ;extrinsic function to verify version 1 signature. Returns 1 if valid, 0 if not valid
55 NEW RECORD,RECORD4,VERSION,SIGBLOCK
56 ;get record variables
57 S RECORD=$G(^PRCF(421,LEVEL0,0))
58 S RECORD4=$G(^PRCF(421,LEVEL0,4))
59 S VERSION=$P(RECORD4,"^",11),SIGBLOCK=$P(RECORD4,"^",12)
60 I VERSION_SIGBLOCK="" QUIT 1
61 QUIT ($$SUM^PRCUESIG($$DECODE(LEVEL0))=SIGBLOCK)
62STRING(X,X4) ;Build String of critical fields
63 Q $P(X,"^",1,2)_"^"_$P(X,"^",4,10)_$P(X,"^",18)_"^"_$P(X4,"^",13)
Note: See TracBrowser for help on using the repository browser.