source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHES10.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1PRCHES10 ;WISC/RHD/AKS-ESIG MAINTENANCE ROUTINE ;4/28/93 15:12
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;ROUTINE FOR MAINTAINING SUBFIELD 7 (ELECTRONIC SIGNATURE)
5 ; FIELD 50 (AMENDMENT) FILE 443.6
6DECODE(LEVEL0,LEVEL1) ;Extrinsic Function to return hashed electronic sig to readable form.
7 ;returns "" if unsuccessful
8 NEW RECORD,RECORD1,VERSION,PERSON,SIG,CHECKSUM
9 S RECORD=$G(^PRC(443.6,LEVEL0,6,LEVEL1,0)) I RECORD="" Q ""
10 S RECORD1=$G(^PRC(443.6,LEVEL0,6,LEVEL1,1))
11 S VERSION=$P(RECORD,"^",9)
12 S PERSON=+$P(RECORD1,"^")
13 I VERSION'="",VERSION'=1 Q ""
14 S SIG=$P(RECORD1,"^",2)
15 I VERSION=1 G D1
16D ;decode e signature less than version 1
17 S X=$$DECODE^PRCUESIG(SIG,LEVEL1,PERSON)
18 Q X
19D1 ;decode e signature for version 1
20 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_LEVEL1_"^"_$$STRING(RECORD,RECORD1))
21 Q $$DECODE^PRCUESIG(SIG,PERSON,CHECKSUM)
22ENCODE(LEVEL0,LEVEL1,USERNUM,Y) ;Encode e signature for version 1 only
23 NEW RECORD,RECORD1,SIGBLOCK,CHECKSUM,OLDUSER
24 S USERNUM=+USERNUM
25 I USERNUM=0 S Y=-3 Q ;-3 no user number available for filing
26 S SIGBLOCK=$P($G(^VA(200,USERNUM,20)),"^",2)
27 I SIGBLOCK="" S Y=-2 Q ;-2 no signature block in file 200
28 S RECORD=$G(^PRC(443.6,LEVEL0,6,LEVEL1,0))
29 S RECORD1=$G(^PRC(443.6,LEVEL0,6,LEVEL1,1))
30 I RECORD="" S Y=-1 Q ;-1 no 2237 record
31 I $P(RECORD1,"^",2)'="" S Y=-4 Q ;-4 cannot re-sign record
32 S OLDUSER=+$P(RECORD1,"^")
33 I OLDUSER=0 S $P(RECORD1,"^")=USERNUM
34 I OLDUSER>0 S USERNUM=OLDUSER
35 S:$P(RECORD1,"^",3)="" $P(RECORD1,"^",3)=$$NOW^PRCUESIG
36 S CHECKSUM=$$SUM^PRCUESIG(LEVEL0_"^"_LEVEL1_"^"_$$STRING(RECORD,RECORD1))
37 S $P(RECORD1,"^",2)=$$ENCODE^PRCUESIG(SIGBLOCK,USERNUM,CHECKSUM)
38 S $P(RECORD,"^",9)="1",$P(RECORD,"^",10)=$$SUM^PRCUESIG(SIGBLOCK)
39 S ^PRC(443.6,LEVEL0,6,LEVEL1,0)=RECORD
40 S ^PRC(443.6,LEVEL0,6,LEVEL1,1)=RECORD1
41 S Y=1 Q
42REMOVE(LEVEL0,LEVEL1) ;Entry point to remove e signature from record
43 NEW RECORD,RECORD1
44 S Y=""
45 ;S RECORD=$G(^PRC(443.6,LEVEL0,6,LEVEL1,0)) Q:RECORD=""
46 ;S $P(^PRC(443.6,LEVEL0,6,LEVEL1,0),"^",2,3)="^",$P(^(0),"^",10)="",$P(^(1),"^")="",$P(^(1),"^",2)=""
47 S RECORD=$G(^PRC(443.6,LEVEL0,6,LEVEL1,0))
48 S RECORD1=$G(^PRC(443.6,LEVEL0,6,LEVEL1,1))
49 I RECORD=""!(RECORD1="") S Y=-1 Q
50 S $P(RECORD1,"^",2,3)="^",$P(RECORD,"^",10)=""
51 S ^PRC(443.6,LEVEL0,6,LEVEL1,0)=RECORD
52 S ^PRC(443.6,LEVEL0,6,LEVEL1,1)=RECORD1
53 Q
54VERIFY(LEVEL0,LEVEL1) ;extrinsic function to verify version 1 signature. Returns 1 if valid, 0 if not valid
55 NEW RECORD1,VERSION,SIGBLOCK
56 S RECORD1=$G(^PRC(443.6,LEVEL0,6,LEVEL1,1))
57 S VERSION=$P(RECORD,"^",9),SIGBLOCK=$P(RECORD,"^",10)
58 I VERSION_SIGBLOCK="" Q 1
59 Q ($$SUM^PRCUESIG($$DECODE(LEVEL0,LEVEL1))=SIGBLOCK)
60STRING(X,X1) ;Build String of critical fields
61 Q $P(X,"^",1,4)_"^"_$P(X1,"^",3)
62 Q
Note: See TracBrowser for help on using the repository browser.