- 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 Feb 18, 2025@23:53 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