[613] | 1 | VAQUTL3 ;ALB/JRP - UTILITY ROUTINES;30-APR-93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
---|
| 3 | TRANENC(TRAN,RET) ;DETERMINE IF ENCRYPTION FOR A TRANSACTION IS TURNED ON
|
---|
| 4 | ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
|
---|
| 5 | ; RET - Flag indicating what to return
|
---|
| 6 | ; 0 = Return 1 if encryption is on (default flag)
|
---|
| 7 | ; Return 0 if encryption is off
|
---|
| 8 | ; 1 = Return pointer to VAQ - ENCRYPTION METHOD file
|
---|
| 9 | ; Return 0 if encryption is off
|
---|
| 10 | ; 2 = Return encryption method
|
---|
| 11 | ; Return NULL if encryption is off
|
---|
| 12 | ; 3 = Return type of encryption
|
---|
| 13 | ; Return NULL if encryption is off
|
---|
| 14 | ;OUTPUT : See definition of RET
|
---|
| 15 | ;NOTES : Existance of VAQIGNC will be checked. If it exists and is
|
---|
| 16 | ; set to 1 encryption will be ignored for this transaction.
|
---|
| 17 | ; : If encryption is on and the transaction does not include
|
---|
| 18 | ; an encryption method, the default encryption method will
|
---|
| 19 | ; be used.
|
---|
| 20 | ; : Encryption off will be returned on error.
|
---|
| 21 | ;
|
---|
| 22 | ;CHECK INPUT
|
---|
| 23 | S RET=+$G(RET)
|
---|
| 24 | Q:('(+$G(TRAN))) $S((RET>1):"",1:0)
|
---|
| 25 | Q:('$D(^VAT(394.61,TRAN))) $S((RET>1):"",1:0)
|
---|
| 26 | ;CHECK VAQIGNC
|
---|
| 27 | Q:($G(VAQIGNC)) $S((RET>1):"",1:0)
|
---|
| 28 | ;DECLARE VARIABLES
|
---|
| 29 | N TMP,MTHD
|
---|
| 30 | ;CHECK ENCRYPTION FIELD
|
---|
| 31 | S TMP=$G(^VAT(394.61,TRAN,"NCRPT"))
|
---|
| 32 | S MTHD=+$P(TMP,"^",2)
|
---|
| 33 | S TMP=+TMP
|
---|
| 34 | ;ENCRYPTION OFF
|
---|
| 35 | Q:('TMP) $S((RET>1):"",1:0)
|
---|
| 36 | ;RETURN ENCRYPTION ON
|
---|
| 37 | Q:('RET) 1
|
---|
| 38 | ;ENCRYPTION METHOD NOT THERE
|
---|
| 39 | I ('MTHD) D Q MTHD
|
---|
| 40 | .S TMP=$S((RET=2):0,1:1)
|
---|
| 41 | .S MTHD=$$DEFENC^VAQUTL2(0,TMP)
|
---|
| 42 | .Q:(RET'=3)
|
---|
| 43 | .I ('MTHD) S MTHD="" Q
|
---|
| 44 | .S MTHD=$P($G(^VAT(394.72,MTHD,0)),"^",1)
|
---|
| 45 | ;RETURN POINTER
|
---|
| 46 | Q:(RET=1) MTHD
|
---|
| 47 | ;RETURN METHOD
|
---|
| 48 | Q:(RET=2) $$ENCMTHD^VAQUTL2(MTHD,0)
|
---|
| 49 | ;RETURN TYPE
|
---|
| 50 | Q:(RET=3) $P($G(^VAT(394.72,MTHD,0)),"^",1)
|
---|
| 51 | ;
|
---|
| 52 | DUZKEY(USER,PRIME) ;DETERMINE PRIMARY/SECONDARY KEY VALUES
|
---|
| 53 | ;INPUT : USER - Pointer to NEW PERSON file (defaults to DUZ)
|
---|
| 54 | ; PRIME - Indicates which key to return
|
---|
| 55 | ; If 1, returns primary key
|
---|
| 56 | ; If 0, returns secondary key (default)
|
---|
| 57 | ;OUTPUT : The primary/secondary key value
|
---|
| 58 | ; NULL - Error
|
---|
| 59 | ;
|
---|
| 60 | ;CHECK INPUT
|
---|
| 61 | S:('(+$G(USER))) USER=+$G(DUZ)
|
---|
| 62 | S PRIME=+$G(PRIME)
|
---|
| 63 | ;DECLARE VARIABLES
|
---|
| 64 | N X,Y
|
---|
| 65 | ;DETERMINE KEYS
|
---|
| 66 | S X=$P($G(^VA(200,USER,0)),"^",1)
|
---|
| 67 | Q:(X="") ""
|
---|
| 68 | S:((USER=.5)!(X="POSTMASTER")) X="PDX Server"
|
---|
| 69 | D:('PRIME) HASH^XUSHSHP
|
---|
| 70 | X ^%ZOSF("LPC")
|
---|
| 71 | Q Y
|
---|
| 72 | ;
|
---|
| 73 | NAMEKEY(USER,PRIME) ;DETERMINE PRIMARY/SECONDARY KEY VALUES
|
---|
| 74 | ;INPUT : USER - Name of user (defaults to current user)
|
---|
| 75 | ; PRIME - Indicates which key to return
|
---|
| 76 | ; If 1, returns primary key
|
---|
| 77 | ; If 0, returns secondary key (default)
|
---|
| 78 | ;OUTPUT : The primary/secondary key value
|
---|
| 79 | ; NULL - Error
|
---|
| 80 | ;
|
---|
| 81 | ;CHECK INPUT
|
---|
| 82 | I ($G(USER)="") S USER=+$G(DUZ) Q:(USER="") S USER=$P($G(^VA(200,USER,0)),"^",1)
|
---|
| 83 | Q:(USER="") ""
|
---|
| 84 | S PRIME=+$G(PRIME)
|
---|
| 85 | ;DECLARE VARIABLES
|
---|
| 86 | N X,Y
|
---|
| 87 | ;DETERMINE KEYS
|
---|
| 88 | S X=USER
|
---|
| 89 | S:(X="POSTMASTER") X="PDX Server"
|
---|
| 90 | Q:(X="") ""
|
---|
| 91 | D:('PRIME) HASH^XUSHSHP
|
---|
| 92 | X ^%ZOSF("LPC")
|
---|
| 93 | Q Y
|
---|