DVBACEM1 ;BEST/JFW - DEMTRAN CONTRACTED EXAM UTILITIES ; 7/17/12 3:13pm
;;2.7;AMIE;**178,185**;Apr 10, 1995;Build 18
;Per VHA Directive 2004-038, this routine should not be modified.
;
; - RPC: DVBAD CONTRACTED EXAM CRYPTO
;
; Encrypts/Decrypts strings, particulary USERNAME/PASSWORD in the
; 2507 EXAM CONTRACTORS File #396.45 for the Disability
; Examination Management Tracking, Referral and Notification
; application (demTRAN).
;
;Input:
; DVBAOVAL: Holds single value or '^' delimited encrypted /
; decrypted results
; DVBAETYP: Type of Cryptography to perform (Required)
; 1 : Encryption
; 2 : Decryption
; DVBAIVAL: Single value or '^' delimited string values
; to perform Cryptography action on (Required)
;Ouput:
; See DVBAOVAL above
;
EN(DVBAOVAL,DVBAETYP,DVBAIVAL) ;Cryptography Entry Point
N DVBAIDNUM
S DVBAIDNUM=290134528 ;Identification Number for Cryptography
S:(DVBAETYP=1) DVBAOVAL=$$ENCRYP(DVBAIVAL,DVBAIDNUM) ;Encryption
S:(DVBAETYP=2) DVBAOVAL=$$DECRYP(DVBAIVAL,DVBAIDNUM) ;Decryption
Q
;
;Input:
; DVBAIVAL: Single value or '^' delimited string values
; to perform Cryptography action on (Required)
; DVBAID: Identification Number to use in Encryption
;Output:
; Returns Single or '^' delimitted encrypted values.
ENCRYP(DVBAIVAL,DVBAID) ;Encryption Entry Point
N X,X1,X2,DVBAI,DVBARSLT
Q:((DVBAIVAL="")!(DVBAID=""))
;Encrypt each value in string
F DVBAI=1:1:$L(DVBAIVAL,"^") D
.S X=$P(DVBAIVAL,"^",DVBAI),X1=DVBAID,X2=1
.D EN^XUSHSHP ;DBIA 10045 - Supported
.S $P(DVBARSLT,"^",DVBAI)=X
Q DVBARSLT
;
;Input:
; DVBAIVAL: Single value or '^' delimited string values
; to perform Cryptography action on (Required)
; DVBAID: Identification Number to use in Decryption
;Output:
; Returns Single or '^' delimitted decrypted values.
DECRYP(DVBAIVAL,DVBAID) ;Decryption Entry Point
N X,X1,X2,DVBAI,DVBARSLT
Q:((DVBAIVAL="")!(DVBAID=""))
;Decrypt each value in string
F DVBAI=1:1:$L(DVBAIVAL,"^") D
.S X=$P(DVBAIVAL,"^",DVBAI),X1=DVBAID,X2=1
.D DE^XUSHSHP ;DBIA 10045 - Supported
.S $P(DVBARSLT,"^",DVBAI)=X
Q DVBARSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBACEM1 2324 printed Apr 09, 2024@20:55:52 Page 2
DVBACEM1 ;BEST/JFW - DEMTRAN CONTRACTED EXAM UTILITIES ; 7/17/12 3:13pm
+1 ;;2.7;AMIE;**178,185**;Apr 10, 1995;Build 18
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; - RPC: DVBAD CONTRACTED EXAM CRYPTO
+5 ;
+6 ; Encrypts/Decrypts strings, particulary USERNAME/PASSWORD in the
+7 ; 2507 EXAM CONTRACTORS File #396.45 for the Disability
+8 ; Examination Management Tracking, Referral and Notification
+9 ; application (demTRAN).
+10 ;
+11 ;Input:
+12 ; DVBAOVAL: Holds single value or '^' delimited encrypted /
+13 ; decrypted results
+14 ; DVBAETYP: Type of Cryptography to perform (Required)
+15 ; 1 : Encryption
+16 ; 2 : Decryption
+17 ; DVBAIVAL: Single value or '^' delimited string values
+18 ; to perform Cryptography action on (Required)
+19 ;Ouput:
+20 ; See DVBAOVAL above
+21 ;
EN(DVBAOVAL,DVBAETYP,DVBAIVAL) ;Cryptography Entry Point
+1 NEW DVBAIDNUM
+2 ;Identification Number for Cryptography
SET DVBAIDNUM=290134528
+3 ;Encryption
if (DVBAETYP=1)
SET DVBAOVAL=$$ENCRYP(DVBAIVAL,DVBAIDNUM)
+4 ;Decryption
if (DVBAETYP=2)
SET DVBAOVAL=$$DECRYP(DVBAIVAL,DVBAIDNUM)
+5 QUIT
+6 ;
+7 ;Input:
+8 ; DVBAIVAL: Single value or '^' delimited string values
+9 ; to perform Cryptography action on (Required)
+10 ; DVBAID: Identification Number to use in Encryption
+11 ;Output:
+12 ; Returns Single or '^' delimitted encrypted values.
ENCRYP(DVBAIVAL,DVBAID) ;Encryption Entry Point
+1 NEW X,X1,X2,DVBAI,DVBARSLT
+2 if ((DVBAIVAL="")!(DVBAID=""))
QUIT
+3 ;Encrypt each value in string
+4 FOR DVBAI=1:1:$LENGTH(DVBAIVAL,"^")
Begin DoDot:1
+5 SET X=$PIECE(DVBAIVAL,"^",DVBAI)
SET X1=DVBAID
SET X2=1
+6 ;DBIA 10045 - Supported
DO EN^XUSHSHP
+7 SET $PIECE(DVBARSLT,"^",DVBAI)=X
End DoDot:1
+8 QUIT DVBARSLT
+9 ;
+10 ;Input:
+11 ; DVBAIVAL: Single value or '^' delimited string values
+12 ; to perform Cryptography action on (Required)
+13 ; DVBAID: Identification Number to use in Decryption
+14 ;Output:
+15 ; Returns Single or '^' delimitted decrypted values.
DECRYP(DVBAIVAL,DVBAID) ;Decryption Entry Point
+1 NEW X,X1,X2,DVBAI,DVBARSLT
+2 if ((DVBAIVAL="")!(DVBAID=""))
QUIT
+3 ;Decrypt each value in string
+4 FOR DVBAI=1:1:$LENGTH(DVBAIVAL,"^")
Begin DoDot:1
+5 SET X=$PIECE(DVBAIVAL,"^",DVBAI)
SET X1=DVBAID
SET X2=1
+6 ;DBIA 10045 - Supported
DO DE^XUSHSHP
+7 SET $PIECE(DVBARSLT,"^",DVBAI)=X
End DoDot:1
+8 QUIT DVBARSLT
