VAQUTL3 ;ALB/JRP - UTILITY ROUTINES;30-APR-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
TRANENC(TRAN,RET) ;DETERMINE IF ENCRYPTION FOR A TRANSACTION IS TURNED ON
;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
; RET - Flag indicating what to return
; 0 = Return 1 if encryption is on (default flag)
; Return 0 if encryption is off
; 1 = Return pointer to VAQ - ENCRYPTION METHOD file
; Return 0 if encryption is off
; 2 = Return encryption method
; Return NULL if encryption is off
; 3 = Return type of encryption
; Return NULL if encryption is off
;OUTPUT : See definition of RET
;NOTES : Existance of VAQIGNC will be checked. If it exists and is
; set to 1 encryption will be ignored for this transaction.
; : If encryption is on and the transaction does not include
; an encryption method, the default encryption method will
; be used.
; : Encryption off will be returned on error.
;
;CHECK INPUT
S RET=+$G(RET)
Q:('(+$G(TRAN))) $S((RET>1):"",1:0)
Q:('$D(^VAT(394.61,TRAN))) $S((RET>1):"",1:0)
;CHECK VAQIGNC
Q:($G(VAQIGNC)) $S((RET>1):"",1:0)
;DECLARE VARIABLES
N TMP,MTHD
;CHECK ENCRYPTION FIELD
S TMP=$G(^VAT(394.61,TRAN,"NCRPT"))
S MTHD=+$P(TMP,"^",2)
S TMP=+TMP
;ENCRYPTION OFF
Q:('TMP) $S((RET>1):"",1:0)
;RETURN ENCRYPTION ON
Q:('RET) 1
;ENCRYPTION METHOD NOT THERE
I ('MTHD) D Q MTHD
.S TMP=$S((RET=2):0,1:1)
.S MTHD=$$DEFENC^VAQUTL2(0,TMP)
.Q:(RET'=3)
.I ('MTHD) S MTHD="" Q
.S MTHD=$P($G(^VAT(394.72,MTHD,0)),"^",1)
;RETURN POINTER
Q:(RET=1) MTHD
;RETURN METHOD
Q:(RET=2) $$ENCMTHD^VAQUTL2(MTHD,0)
;RETURN TYPE
Q:(RET=3) $P($G(^VAT(394.72,MTHD,0)),"^",1)
;
DUZKEY(USER,PRIME) ;DETERMINE PRIMARY/SECONDARY KEY VALUES
;INPUT : USER - Pointer to NEW PERSON file (defaults to DUZ)
; PRIME - Indicates which key to return
; If 1, returns primary key
; If 0, returns secondary key (default)
;OUTPUT : The primary/secondary key value
; NULL - Error
;
;CHECK INPUT
S:('(+$G(USER))) USER=+$G(DUZ)
S PRIME=+$G(PRIME)
;DECLARE VARIABLES
N X,Y
;DETERMINE KEYS
S X=$P($G(^VA(200,USER,0)),"^",1)
Q:(X="") ""
S:((USER=.5)!(X="POSTMASTER")) X="PDX Server"
D:('PRIME) HASH^XUSHSHP
X ^%ZOSF("LPC")
Q Y
;
NAMEKEY(USER,PRIME) ;DETERMINE PRIMARY/SECONDARY KEY VALUES
;INPUT : USER - Name of user (defaults to current user)
; PRIME - Indicates which key to return
; If 1, returns primary key
; If 0, returns secondary key (default)
;OUTPUT : The primary/secondary key value
; NULL - Error
;
;CHECK INPUT
I ($G(USER)="") S USER=+$G(DUZ) Q:(USER="") S USER=$P($G(^VA(200,USER,0)),"^",1)
Q:(USER="") ""
S PRIME=+$G(PRIME)
;DECLARE VARIABLES
N X,Y
;DETERMINE KEYS
S X=USER
S:(X="POSTMASTER") X="PDX Server"
Q:(X="") ""
D:('PRIME) HASH^XUSHSHP
X ^%ZOSF("LPC")
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUTL3 3087 printed Oct 16, 2024@18:27:41 Page 2
VAQUTL3 ;ALB/JRP - UTILITY ROUTINES;30-APR-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
TRANENC(TRAN,RET) ;DETERMINE IF ENCRYPTION FOR A TRANSACTION IS TURNED ON
+1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
+2 ; RET - Flag indicating what to return
+3 ; 0 = Return 1 if encryption is on (default flag)
+4 ; Return 0 if encryption is off
+5 ; 1 = Return pointer to VAQ - ENCRYPTION METHOD file
+6 ; Return 0 if encryption is off
+7 ; 2 = Return encryption method
+8 ; Return NULL if encryption is off
+9 ; 3 = Return type of encryption
+10 ; Return NULL if encryption is off
+11 ;OUTPUT : See definition of RET
+12 ;NOTES : Existance of VAQIGNC will be checked. If it exists and is
+13 ; set to 1 encryption will be ignored for this transaction.
+14 ; : If encryption is on and the transaction does not include
+15 ; an encryption method, the default encryption method will
+16 ; be used.
+17 ; : Encryption off will be returned on error.
+18 ;
+19 ;CHECK INPUT
+20 SET RET=+$GET(RET)
+21 if ('(+$GET(TRAN)))
QUIT $SELECT((RET>1):"",1:0)
+22 if ('$DATA(^VAT(394.61,TRAN)))
QUIT $SELECT((RET>1):"",1:0)
+23 ;CHECK VAQIGNC
+24 if ($GET(VAQIGNC))
QUIT $SELECT((RET>1):"",1:0)
+25 ;DECLARE VARIABLES
+26 NEW TMP,MTHD
+27 ;CHECK ENCRYPTION FIELD
+28 SET TMP=$GET(^VAT(394.61,TRAN,"NCRPT"))
+29 SET MTHD=+$PIECE(TMP,"^",2)
+30 SET TMP=+TMP
+31 ;ENCRYPTION OFF
+32 if ('TMP)
QUIT $SELECT((RET>1):"",1:0)
+33 ;RETURN ENCRYPTION ON
+34 if ('RET)
QUIT 1
+35 ;ENCRYPTION METHOD NOT THERE
+36 IF ('MTHD)
Begin DoDot:1
+37 SET TMP=$SELECT((RET=2):0,1:1)
+38 SET MTHD=$$DEFENC^VAQUTL2(0,TMP)
+39 if (RET'=3)
QUIT
+40 IF ('MTHD)
SET MTHD=""
QUIT
+41 SET MTHD=$PIECE($GET(^VAT(394.72,MTHD,0)),"^",1)
End DoDot:1
QUIT MTHD
+42 ;RETURN POINTER
+43 if (RET=1)
QUIT MTHD
+44 ;RETURN METHOD
+45 if (RET=2)
QUIT $$ENCMTHD^VAQUTL2(MTHD,0)
+46 ;RETURN TYPE
+47 if (RET=3)
QUIT $PIECE($GET(^VAT(394.72,MTHD,0)),"^",1)
+48 ;
DUZKEY(USER,PRIME) ;DETERMINE PRIMARY/SECONDARY KEY VALUES
+1 ;INPUT : USER - Pointer to NEW PERSON file (defaults to DUZ)
+2 ; PRIME - Indicates which key to return
+3 ; If 1, returns primary key
+4 ; If 0, returns secondary key (default)
+5 ;OUTPUT : The primary/secondary key value
+6 ; NULL - Error
+7 ;
+8 ;CHECK INPUT
+9 if ('(+$GET(USER)))
SET USER=+$GET(DUZ)
+10 SET PRIME=+$GET(PRIME)
+11 ;DECLARE VARIABLES
+12 NEW X,Y
+13 ;DETERMINE KEYS
+14 SET X=$PIECE($GET(^VA(200,USER,0)),"^",1)
+15 if (X="")
QUIT ""
+16 if ((USER=.5)!(X="POSTMASTER"))
SET X="PDX Server"
+17 if ('PRIME)
DO HASH^XUSHSHP
+18 XECUTE ^%ZOSF("LPC")
+19 QUIT Y
+20 ;
NAMEKEY(USER,PRIME) ;DETERMINE PRIMARY/SECONDARY KEY VALUES
+1 ;INPUT : USER - Name of user (defaults to current user)
+2 ; PRIME - Indicates which key to return
+3 ; If 1, returns primary key
+4 ; If 0, returns secondary key (default)
+5 ;OUTPUT : The primary/secondary key value
+6 ; NULL - Error
+7 ;
+8 ;CHECK INPUT
+9 IF ($GET(USER)="")
SET USER=+$GET(DUZ)
if (USER="")
QUIT
SET USER=$PIECE($GET(^VA(200,USER,0)),"^",1)
+10 if (USER="")
QUIT ""
+11 SET PRIME=+$GET(PRIME)
+12 ;DECLARE VARIABLES
+13 NEW X,Y
+14 ;DETERMINE KEYS
+15 SET X=USER
+16 if (X="POSTMASTER")
SET X="PDX Server"
+17 if (X="")
QUIT ""
+18 if ('PRIME)
DO HASH^XUSHSHP
+19 XECUTE ^%ZOSF("LPC")
+20 QUIT Y
