XUKSPTLSF ;SLC/JLA - Kernel System Parameters TLS Form callback API's ; MAY 1, 2025@7:30
;;8.0;KERNEL;**787**;Jul 10, 1995;Build 73
;Per VA Directive 6402, this routine should not be modified.
;
; FileMan/ScreenMan API's
;
FMDIE D ^DIE Q
GET1(AFILE,AIENS,AFIELD,AFLAGS,ATROOT,AMROOT) Q $$GET1^DIQ($G(AFILE),$G(AIENS),$G(AFIELD),$G(AFLAGS),$G(ATROOT),$G(AMROOT))
;
;
; TLS API's
;
; Get Kernal System Parameters TLS Configuration Name
GKSPTLSCN() Q $$GKSPTLSCN^XUTLS()
;
; Get the TLS Server Configuration Names from the Security.SSLConfigs table
GTLSSVRCNS(AconfigNames) Q $$GETTLSSERVERCNS^XUSUDO(.AconfigNames)
;
;
; Save the value of the global ^TMP("TLS",$J,"CONFIG","DEFAULT") in the
; Kernel System Parameter "TLS CONFIGURATION" (FILE=8989.3, FIELD=667)
; If there is no value in the global, store "UNKNOWN"
;
; D SAVETLSNAME^XUKSPTLSF()
;
SAVETLSNAME() ;
NEW KSPFILE,KSPIEN,TLSFIELD,TLSNAME,RTNVAL
NEW DIE,DA,DR,DIK
I '$D(^TMP("TLS",$J,"CONFIG","DEFAULT")) D G SVTLSNMDN
. S RTNVAL="0^TMP(""TLS"",$J,""CONFIG"",""DEFAULT"") must be assigned the value you want saved"
S KSPFILE=8989.3 ; File number of Kernel System Parameter file
S KSPIEN=1 ; Only one record
; Set the Global root of the Kernel System Parameter file
S KSPGLBROOT="^XTV("_KSPFILE_","
; Setup the DIE call
S DIE=KSPGLBROOT ; Global root of subfile
S TLSFIELD=667
S TLSNAME=$G(^TMP("TLS",$J,"CONFIG","DEFAULT"))
S:$L(TLSNAME)=0 TLSNAME="UNKNOWN"
S DA=KSPIEN
S DR=""_TLSFIELD_"////"_TLSNAME
D FMDIE
S RTNVAL="1^Default TLS Config. saved."
SVTLSNMDN ;
Q RTNVAL
;
;
; N TLSNA S TLSNA=""
; S QR=$$GTLSNAMES^XUKSPTLSF(.TLSNA)
;
GTLSNAMES(ATLSNAMESA) ;
N RTNVAL,QR
I '$D(ATLSNAMESA) D G GTLSNMDN
. S RTNVAL="0^Undefined TLS Names array parameter"
S QR=$$GTLSSVRCNS(.ATLSNAMESA)
I 'QR D G GTLSNMDN
. S RTNVAL="0^IRIS call to $$GETTLSSERVERCNS^XUSUDO() failed"
M ^TMP("TLS",$J,"CONFIG","NAMES")=ATLSNAMESA
S RTNVAL="1^GTLSNAMES"
GTLSNMDN ;
Q RTNVAL
;
;
; Get the Form help message showing all TLS Configuration Names available
;
; N HMA S HMA=""
; W $$GTLSHM^XUKSPTLSF(.HMA)
;
GTLSHM(ATLSHMA) ;
N RTNVAL
S RTNVAL=1
I '$D(ATLSHMA) D G GTLSHMDN
. S RTNVAL="0^Undefined TLS Help Message Parameter"
S ATLSHMA(0)="Enter the number that corresponds to the TLS server configuration name:"
N TLSNAMES,I
S TLSNAMES(0)=0
D GTLSNAMES(.TLSNAMES)
I TLSNAMES(0)=0 D G GTLSHMDN
. S RTNVAL="0^There are no TLS Server Configurations available, see system administrator"
. S ATLSHMA(0)=$P(RTNVAL,"^",2)
F I=1:1:TLSNAMES(0) D
. S ATLSHMA(I)=""_I_". "_TLSNAMES(I)
GTLSHMDN ;
Q RTNVAL
;
;
; Get TLS Configuration Name from global ^TMP("TLS",$J,"CONFIG","NAMES",AINDEX)
; If there is no value in the global, return ""
;
; S INDEX=1 W $$GTLSG^XUKSPTLSF(INDEX)
;
GTLSG(AINDEX) ;
N TLSNAME
S TLSNAME=$G(^TMP("TLS",$J,"CONFIG","NAMES",AINDEX))
Q TLSNAME
;
;
; Form post save routine
;
FRMPOSTS() ; FORM POST SAVE
N RTNVAL S RTNVAL=0
S RTNVAL="1^FORM POST SAVE Called"
D SAVETLSNAME()
K ^TMP("TLS",$J)
Q RTNVAL
;
;
; Page Pre Action routine
;
PGPREA() ; PAGE PRE ACTION
N RTNVAL,DTLSN
K ^TMP("TLS",$J)
S RTNVAL=$$GKSPTLSCN()
Q RTNVAL
;
;
; TLS Name Pre routine
;
; N HLP S HLP=""
; S RTNVAL=$$TLSNPRE^XUKSPTLSF(.HLP)
;
TLSNPRE(ATLSNHMA) ;
N RTNVAL
S RTNVAL=$$GTLSHM(.ATLSNHMA)
Q RTNVAL
;
; Field TLSN input transform.
; Transform the number entered by the Form user and passed as AINDEX to this function
; to the corresponding TLS Configuration Name saved in ^TMP("TLS",$J,"CONFIG","NAMES",AINDEX)
; Set the global ^TMP("TLS",$J,"CONFIG","DEFAULT") with the TLS Configuration Name
; found in ^TMP("TLS",$J,"CONFIG","NAMES",AINDEX).
;
; S INDEX=2 W $$TLSNX^XUKSPTLSF(INDEX)
;
TLSNX(AINDEX) ;
N TLSNAME,INDEX,GTLSNAME,CNC
S TLSNAME="0^UNKNOWN",CNC=0
I $D(^TMP("TLS",$J,"CONFIG","NAMES",0)) S CNC=+(^TMP("TLS",$J,"CONFIG","NAMES",0))
I CNC=1 S AINDEX=1
S INDEX=+$G(AINDEX)
I (INDEX'=AINDEX)!(INDEX<=0)!(INDEX>CNC) G TLSNXDN
S GTLSNAME=$$GTLSG(INDEX)
I $L(GTLSNAME)>2 D
. S ^TMP("TLS",$J,"CONFIG","DEFAULT")=GTLSNAME
. S TLSNAME="1^"_GTLSNAME
TLSNXDN ;
Q TLSNAME
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUKSPTLSF 4295 printed Jul 11, 2026@02:06:43 Page 2
XUKSPTLSF ;SLC/JLA - Kernel System Parameters TLS Form callback API's ; MAY 1, 2025@7:30
+1 ;;8.0;KERNEL;**787**;Jul 10, 1995;Build 73
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; FileMan/ScreenMan API's
+5 ;
FMDIE DO ^DIE
QUIT
GET1(AFILE,AIENS,AFIELD,AFLAGS,ATROOT,AMROOT) QUIT $$GET1^DIQ($GET(AFILE),$GET(AIENS),$GET(AFIELD),$GET(AFLAGS),$GET(ATROOT),$GET(AMROOT))
+1 ;
+2 ;
+3 ; TLS API's
+4 ;
+5 ; Get Kernal System Parameters TLS Configuration Name
GKSPTLSCN() QUIT $$GKSPTLSCN^XUTLS()
+1 ;
+2 ; Get the TLS Server Configuration Names from the Security.SSLConfigs table
GTLSSVRCNS(AconfigNames) QUIT $$GETTLSSERVERCNS^XUSUDO(.AconfigNames)
+1 ;
+2 ;
+3 ; Save the value of the global ^TMP("TLS",$J,"CONFIG","DEFAULT") in the
+4 ; Kernel System Parameter "TLS CONFIGURATION" (FILE=8989.3, FIELD=667)
+5 ; If there is no value in the global, store "UNKNOWN"
+6 ;
+7 ; D SAVETLSNAME^XUKSPTLSF()
+8 ;
SAVETLSNAME() ;
+1 NEW KSPFILE,KSPIEN,TLSFIELD,TLSNAME,RTNVAL
+2 NEW DIE,DA,DR,DIK
+3 IF '$DATA(^TMP("TLS",$JOB,"CONFIG","DEFAULT"))
Begin DoDot:1
+4 SET RTNVAL="0^TMP(""TLS"",$J,""CONFIG"",""DEFAULT"") must be assigned the value you want saved"
End DoDot:1
GOTO SVTLSNMDN
+5 ; File number of Kernel System Parameter file
SET KSPFILE=8989.3
+6 ; Only one record
SET KSPIEN=1
+7 ; Set the Global root of the Kernel System Parameter file
+8 SET KSPGLBROOT="^XTV("_KSPFILE_","
+9 ; Setup the DIE call
+10 ; Global root of subfile
SET DIE=KSPGLBROOT
+11 SET TLSFIELD=667
+12 SET TLSNAME=$GET(^TMP("TLS",$JOB,"CONFIG","DEFAULT"))
+13 if $LENGTH(TLSNAME)=0
SET TLSNAME="UNKNOWN"
+14 SET DA=KSPIEN
+15 SET DR=""_TLSFIELD_"////"_TLSNAME
+16 DO FMDIE
+17 SET RTNVAL="1^Default TLS Config. saved."
SVTLSNMDN ;
+1 QUIT RTNVAL
+2 ;
+3 ;
+4 ; N TLSNA S TLSNA=""
+5 ; S QR=$$GTLSNAMES^XUKSPTLSF(.TLSNA)
+6 ;
GTLSNAMES(ATLSNAMESA) ;
+1 NEW RTNVAL,QR
+2 IF '$DATA(ATLSNAMESA)
Begin DoDot:1
+3 SET RTNVAL="0^Undefined TLS Names array parameter"
End DoDot:1
GOTO GTLSNMDN
+4 SET QR=$$GTLSSVRCNS(.ATLSNAMESA)
+5 IF 'QR
Begin DoDot:1
+6 SET RTNVAL="0^IRIS call to $$GETTLSSERVERCNS^XUSUDO() failed"
End DoDot:1
GOTO GTLSNMDN
+7 MERGE ^TMP("TLS",$JOB,"CONFIG","NAMES")=ATLSNAMESA
+8 SET RTNVAL="1^GTLSNAMES"
GTLSNMDN ;
+1 QUIT RTNVAL
+2 ;
+3 ;
+4 ; Get the Form help message showing all TLS Configuration Names available
+5 ;
+6 ; N HMA S HMA=""
+7 ; W $$GTLSHM^XUKSPTLSF(.HMA)
+8 ;
GTLSHM(ATLSHMA) ;
+1 NEW RTNVAL
+2 SET RTNVAL=1
+3 IF '$DATA(ATLSHMA)
Begin DoDot:1
+4 SET RTNVAL="0^Undefined TLS Help Message Parameter"
End DoDot:1
GOTO GTLSHMDN
+5 SET ATLSHMA(0)="Enter the number that corresponds to the TLS server configuration name:"
+6 NEW TLSNAMES,I
+7 SET TLSNAMES(0)=0
+8 DO GTLSNAMES(.TLSNAMES)
+9 IF TLSNAMES(0)=0
Begin DoDot:1
+10 SET RTNVAL="0^There are no TLS Server Configurations available, see system administrator"
+11 SET ATLSHMA(0)=$PIECE(RTNVAL,"^",2)
End DoDot:1
GOTO GTLSHMDN
+12 FOR I=1:1:TLSNAMES(0)
Begin DoDot:1
+13 SET ATLSHMA(I)=""_I_". "_TLSNAMES(I)
End DoDot:1
GTLSHMDN ;
+1 QUIT RTNVAL
+2 ;
+3 ;
+4 ; Get TLS Configuration Name from global ^TMP("TLS",$J,"CONFIG","NAMES",AINDEX)
+5 ; If there is no value in the global, return ""
+6 ;
+7 ; S INDEX=1 W $$GTLSG^XUKSPTLSF(INDEX)
+8 ;
GTLSG(AINDEX) ;
+1 NEW TLSNAME
+2 SET TLSNAME=$GET(^TMP("TLS",$JOB,"CONFIG","NAMES",AINDEX))
+3 QUIT TLSNAME
+4 ;
+5 ;
+6 ; Form post save routine
+7 ;
FRMPOSTS() ; FORM POST SAVE
+1 NEW RTNVAL
SET RTNVAL=0
+2 SET RTNVAL="1^FORM POST SAVE Called"
+3 DO SAVETLSNAME()
+4 KILL ^TMP("TLS",$JOB)
+5 QUIT RTNVAL
+6 ;
+7 ;
+8 ; Page Pre Action routine
+9 ;
PGPREA() ; PAGE PRE ACTION
+1 NEW RTNVAL,DTLSN
+2 KILL ^TMP("TLS",$JOB)
+3 SET RTNVAL=$$GKSPTLSCN()
+4 QUIT RTNVAL
+5 ;
+6 ;
+7 ; TLS Name Pre routine
+8 ;
+9 ; N HLP S HLP=""
+10 ; S RTNVAL=$$TLSNPRE^XUKSPTLSF(.HLP)
+11 ;
TLSNPRE(ATLSNHMA) ;
+1 NEW RTNVAL
+2 SET RTNVAL=$$GTLSHM(.ATLSNHMA)
+3 QUIT RTNVAL
+4 ;
+5 ; Field TLSN input transform.
+6 ; Transform the number entered by the Form user and passed as AINDEX to this function
+7 ; to the corresponding TLS Configuration Name saved in ^TMP("TLS",$J,"CONFIG","NAMES",AINDEX)
+8 ; Set the global ^TMP("TLS",$J,"CONFIG","DEFAULT") with the TLS Configuration Name
+9 ; found in ^TMP("TLS",$J,"CONFIG","NAMES",AINDEX).
+10 ;
+11 ; S INDEX=2 W $$TLSNX^XUKSPTLSF(INDEX)
+12 ;
TLSNX(AINDEX) ;
+1 NEW TLSNAME,INDEX,GTLSNAME,CNC
+2 SET TLSNAME="0^UNKNOWN"
SET CNC=0
+3 IF $DATA(^TMP("TLS",$JOB,"CONFIG","NAMES",0))
SET CNC=+(^TMP("TLS",$JOB,"CONFIG","NAMES",0))
+4 IF CNC=1
SET AINDEX=1
+5 SET INDEX=+$GET(AINDEX)
+6 IF (INDEX'=AINDEX)!(INDEX<=0)!(INDEX>CNC)
GOTO TLSNXDN
+7 SET GTLSNAME=$$GTLSG(INDEX)
+8 IF $LENGTH(GTLSNAME)>2
Begin DoDot:1
+9 SET ^TMP("TLS",$JOB,"CONFIG","DEFAULT")=GTLSNAME
+10 SET TLSNAME="1^"_GTLSNAME
End DoDot:1
TLSNXDN ;
+1 QUIT TLSNAME
+2 ;
+3 ;
