PSOSPMKY ;BIRM/MFR - State Prescription Monitoring Program - SSH Key Management ;01/06/16
;;7.0;OUTPATIENT PHARMACY;**451,625,723**;DEC 1997;Build 13
;
EN ; Entry-point
N STATEIEN,DIC,X,Y,DUOUT,DTOUT,PSOOS,LOCALDIR,X1,DIR,DIRUT,LOCALDIR
W ! K DIC S DIC("A")="Select STATE: ",DIC="^PS(58.41,",DIC(0)="QOEAM"
I $O(^PS(58.41,0)) S DIC("B")=$O(^PS(58.41,0))
D ^DIC I X=""!(X="^")!$D(DUOUT)!$D(DTOUT) G END
K DIC("A") G:Y<0 EN S STATEIEN=+Y
;
ACTION ; SSH Key Action
K DIR S DIR("A")="Action"
S DIR(0)="S^V:View Public SSH Key;N:Create New SSH Key Pair;"
S DIR(0)=DIR(0)_"D:Delete SSH Key Pair;H:Help with SSH Keys"
S DIR("B")="V" D ^DIR I $D(DUOUT)!($D(DIRUT)) G END
I Y="N"!(Y="D"),'$D(^XUSEC("PSO SPMP ADMIN",DUZ)) D G ACTION
. W !!,"The PSO SPMP ADMIN security key is required for this action.",$C(7)
K ^TMP("PSOPUBKY",$J) D RETRIEVE(STATEIEN,"PUB")
I Y="V"!(Y="D"),'$D(^TMP("PSOPUBKY",$J)) D G ACTION
. W !!,"[No SSH Key Pair found for ",$$GET1^DIQ(5,STATEIEN,.01),"]",$C(7) D PAUSE^PSOSPMU1
I Y="N"!(Y="D") D SIG^XUSESIG I X="^"!($G(X1)="") W:$G(X1)="" " SIGNATURE NOT VERIFIED",$C(7) G ACTION
;
; View Public SSH Key
I Y="V" D G ACTION
. W ! D VIEW(STATEIEN),PAUSE^PSOSPMU1
;
; Create New SSH Key Pair
I Y="N" D G ACTION
. S PSOOS=$$BKENDOS()
. S LOCALDIR=$$GET1^DIQ(58.41,STATEIEN,$S(PSOOS["VMS":4,1:15))
. I LOCALDIR="" D Q
. . W !!,"The ",$S(PSOOS["VMS":"OPEN VMS",1:"UNIX/LINUX")," LOCAL DIRECTORY parameter is missing for ",$$GET1^DIQ(5,STATEIEN,.01),". Please,"
. . W !,"update it in the View/Edit SPMP State Parameters option and try again.",$C(7) D PAUSE^PSOSPMU1
. K DIR S DIR("A")="SSH Key Encryption Type",DIR("?")="^D ETHELP^PSOSPMKY"
. S DIR(0)="S^RSA:Rivest, Shamir & Adleman (RSA);DSA:Digital Signature Algorithm (DSA);ECDSA:Elliptic Curve Digital Signature Algorithm (ECDSA);EDDSA:Edward-curve Digital Signature Algorithm (ed25519)" ;p723
. S DIR("B")="RSA" D ^DIR I $D(DUOUT)!($D(DIRUT)) Q
. S ENCRTYPE=Y I Y="DSA" D Q
. . W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," 'DSA' SSH keys are being phased out and are no longer supported.",$C(7)
. ;p723 prompt for bit size for ECDSA
. I ENCRTYPE="ECDSA" D I $D(DUOUT)!($D(DIRUT)) Q
. . K DIR S DIR("A")="ECDSA encryption key size (bit size)",DIR("?")="Available key sizes are 256 bits, 384 bits, or 521 bits. Also referred to as key length."
. . S DIR(0)="S^256:256 bits;384:384 bits;521:521 bits"
. . S DIR("B")="256" D ^DIR
. S ENCRBITS=$S(ENCRTYPE="ECDSA":Y,1:"")
. I $D(^TMP("PSOPUBKY",$J)) D
. . W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," You may be overwriting SSH Keys that are currently in use.",$C(7)
. K DIR S DIR("A")="Confirm Creation of SSH "_ENCRTYPE_" Keys for "_$$GET1^DIQ(5,STATEIEN,.01),DIR(0)="Y",DIR("B")="NO"
. W ! D ^DIR I $D(DIRUT)!$D(DUOUT)!'Y Q
. ; Deleting Existing SSH Key
. I $D(^TMP("PSOPUBKY",$J)) D DELETE(STATEIEN)
. W !!,"Creating New SSH Keys, please wait..."
. ;p723 removing the task off logic, unnecessary
. ;N ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK
. ;S ZTRTN="NEWKEY^PSOSPMKY("_STATEIEN_","""_ENCRTYPE_""")"
. ;S ZTDESC="State Prescription Monitoring Program (SPMP) SSH Key Generation"
. ;S ZTDTH=$$NOW^XLFDT() D ^%ZTLOAD K ZTSK
. ;K ^TMP("PSOPUBKY",$J)
. ;F I=1:1:30 D RETRIEVE(STATEIEN,"PUB") Q:$D(^TMP("PSOPUBKY",$J)) H 1
. ; If unable to create the key via Taskman after 30 seconds, creates them in the foreground
. ;I '$D(^TMP("PSOPUBKY",$J)) D
. D NEWKEY(STATEIEN,ENCRTYPE,ENCRBITS),RETRIEVE(STATEIEN,"PUB") ;p723 pass ENCRBITS
. I '$D(^TMP("PSOPUBKY",$J)) D
. . W !!,"There was a problem with the generation of the new SSH Key Pair."
. . W !,"Please try again and if the problem persists contact IT Support.",$C(7) D PAUSE^PSOSPMU1
. E W "Done",$C(7)
K ENCRBITS
;
; Delete SSH Key Pair
I Y="D" D G ACTION
. D RETRIEVE(STATEIEN,"PUB")
. I '$D(^TMP("PSOPUBKY",$J)) D Q
. . W !!,"[No SSH Key Pair found for ",$$GET1^DIQ(5,STATEIEN,.01),"]",$C(7)
. W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," You may be deleting SSH Keys that are currently in use.",$C(7)
. K DIR S DIR("A")="Confirm Deletion of "_$$GET1^DIQ(5,STATEIEN,.01)_"'s SSH Keys",DIR(0)="Y",DIR("B")="NO"
. W ! D ^DIR I $D(DIRUT)!$D(DUOUT)!'Y Q
. W !!,"Deleting SSH Keys..." D DELETE(STATEIEN) H 1 W "Done",$C(7)
;
; SSH Key Help
I Y="H" D HELP G ACTION
;
G ACTION
;
END Q
;
NEWKEY(STATEIEN,ENCRTYPE,ENCRBITS) ; Generate and store a pair of SSH keys for a specific state
; Input: (r) STATEIEN - State that will be using the new key pair. Pointer to the STATE file (#5)
; (o) ENCRTYPE - SSH Encryption Type (DSA / RSA) (Default: RSA)
N LOCALDIR,DATETIME,PSOOS,KEYFILE,PV,FILE2DEL,LINE,OVFLINE,NMSPC,KEYTXT,SAVEKEY,DIE,DR,DA
;
I '$G(STATEIEN) Q ;Error: State missing
S PSOOS=$$OS^%ZOSV()
S LOCALDIR=$$GET1^DIQ(58.41,STATEIEN,$S(PSOOS["VMS":4,1:15)) I LOCALDIR="" Q ;Error: Missing directory
;I $G(ENCRTYPE)'="DSA",$G(ENCRTYPE)'="RSA" S ENCRTYPE="RSA"
S ENCRTYPE=$S($G(ENCRTYPE)="ECDSA":"ECDSA",$G(ENCRTYPE)="EDDSA":"ed25519",1:"RSA")
;
; LOCK to avoid OS files overwrite
F S DATETIME=$P($$FMTHL7^XLFDT($$HTFM^XLFDT($H)),"-") S KEYFILE="KEY"_DATETIME L +@KEYFILE:0 Q:$T H 2
;
; Deleting existing SSH Keys first
D DELETE(STATEIEN)
;
; OpenVMS SSH Key Generation
I PSOOS["VMS" D
. N COMFILE
. S COMFILE="COM"_DATETIME_".COM"
. D OPEN^%ZISH("COMFILE",LOCALDIR,COMFILE,"W")
. D USE^%ZISUTL("COMFILE")
. W "SSH_KEYGEN == ""$SYS$SYSTEM:TCPIP$SSH_SSH-KEYGEN2.EXE""",!
. W "SSH_KEYGEN -t "_$$LOW^XLFSTR($G(ENCRTYPE))_" -""P"" "_LOCALDIR_KEYFILE,!
. D CLOSE^%ZISH("COMFILE")
. X "S PV=$ZF(-1,""@"_LOCALDIR_COMFILE_""")"
. S FILE2DEL(COMFILE)="",FILE2DEL(KEYFILE_".")="",FILE2DEL(KEYFILE_".PUB")=""
;
; Linux/Unix SSH Key Generation
I PSOOS["UNIX" D
. I '$$DIREXIST^PSOSPMU1(LOCALDIR) D MAKEDIR^PSOSPMU1(LOCALDIR)
. S ENCRBITS=$S($G(ENCRBITS):" -b "_ENCRBITS,1:"")
. X "S PV=$ZF(-1,""ssh-keygen -q -N '' -C '' -t "_$$LOW^XLFSTR($G(ENCRTYPE))_" -f "_LOCALDIR_KEYFILE_ENCRBITS_""")"
. S FILE2DEL(KEYFILE)="",FILE2DEL(KEYFILE_".pub")=""
;
K ^TMP("PSOPRVKY",$J),^TMP("PSOPUBKY",$J)
; Retrieving SSH Private Key Content
S X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$S(PSOOS["VMS":".",1:""),$NAME(^TMP("PSOPRVKY",$J,1)),3)
I '$D(^TMP("PSOPRVKY",$J,1)) Q
; Retrieving SSH Public Key Content
S X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$S(PSOOS["VMS":".PUB",1:".pub"),$NAME(^TMP("PSOPUBKY",$J,1)),3)
I '$D(^TMP("PSOPUBKY",$J,1)) Q
;
; Deleting temporary files used to generate the keys
D DEL^%ZISH(LOCALDIR,"FILE2DEL")
;
; Saving new SSH Keys content in the SPMP STATE PARAMETERS file (#58.41)
F NMSPC="PSOPRVKY","PSOPUBKY" D
. K KEYTXT,SAVEKEY
. F LINE=1:1 Q:'$D(^TMP(NMSPC,$J,LINE)) D
. . ; Unix/Linux Public SSH Key has no line-feed (one long line)
. . I PSOOS["UNIX",NMSPC="PSOPUBKY" D Q
. . . S KEYTXT(1)=^TMP(NMSPC,$J,LINE)
. . . F OVFLINE=1:1 Q:'$D(^TMP(NMSPC,$J,LINE,"OVF",OVFLINE)) D
. . . . S KEYTXT(1)=$G(KEYTXT(1))_^TMP(NMSPC,$J,LINE,"OVF",OVFLINE)
. . S KEYTXT(LINE)=$$ENCRYP^XUSRB1(^TMP(NMSPC,$J,LINE))
. I PSOOS["UNIX",NMSPC="PSOPUBKY" S KEYTXT(1)=$$ENCRYP^XUSRB1(KEYTXT(1))
. S SAVEKEY(58.41,STATEIEN_",",$S(NMSPC="PSOPRVKY":100,1:200))="KEYTXT"
. D UPDATE^DIE("","SAVEKEY")
. K ^TMP(NMSPC,$J)
;
; Saving SSH Key Format (SSH2/OpenSSH) and Encryption Type (DSA/RSA) fields
K DIE S DIE="^PS(58.41,",DA=STATEIEN
S DR="18///"_$S(PSOOS["VMS":"SSH2",1:"OSSH")_";19////"_ENCRTYPE D ^DIE
;
L -@KEYFILE
Q
;
RETRIEVE(STATEIEN,KEYTYPE) ; Retrieve the SSH Key into the ^TMP global
; Input: (r) STATEIEN - State to retrieve the SSH Key from
; (o) KEYTYPE - SSH Key Type (PUB - Public / PRV - PRivate) (Default: Public)
;Output: ^TMP("PSO[PUB/PRV]KY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
; ^TMP("PSO[PUB/PRV]KY",$J,1-N)=[SSH Key Content]
N X,LINE,KEYTXT,NMSPC
I $G(KEYTYPE)'="PUB",$G(KEYTYPE)'="PRV" S KEYTYPE="PUB"
S X=$$GET1^DIQ(58.41,STATEIEN_",",$S(KEYTYPE="PRV":100,1:200),,"KEYTXT")
S NMSPC=$S(KEYTYPE="PRV":"PSOPRVKY",1:"PSOPUBKY")
K ^TMP(NMSPC,$J)
F LINE=1:1 Q:'$D(KEYTXT(LINE)) D
. S ^TMP(NMSPC,$J,LINE)=$$DECRYP^XUSRB1(KEYTXT(LINE))
I $D(^TMP(NMSPC,$J)) D
. S ^TMP(NMSPC,$J,0)=$$GET1^DIQ(58.41,STATEIEN,18,"I")_"^"_$$GET1^DIQ(58.41,STATEIEN,19,"I")
Q
;
VIEW(STATEIEN) ; Displays the SSH Public Key
;Input: (r) STATEIEN - State to display the Public SSH Key for
; ^TMP("PSOPUBKY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
; ^TMP("PSOPUBKY",$J,1-N)=[SSH Key Content]
N SSHKEY,DASHLN
I '$G(STATEIEN) Q
S SSHKEY=$$OPENSSH(),$P(DASHLN,"-",81)=""
W !,$$GET1^DIQ(5,STATEIEN,.01),"'s Public SSH Key (",$P($G(^TMP("PSOPUBKY",$J,0)),"^",2),") content (does not include dash lines):"
W !,DASHLN
F Q:$L(SSHKEY)=0 W !,$E(SSHKEY,1,80) S SSHKEY=$E(SSHKEY,81,9999)
W !,DASHLN
Q
;
DELETE(STATEIEN) ; Delete Both SSH Keys associated with the State
;Input: (r) STATEIEN - State from what the key should be deleted from in the SPMP STATE PARAMETERS file (#58.41)
N DIE,DA,DR
S DIE="^PS(58.41,",DA=+$G(STATEIEN),DR="18///@;19///@;100///@;200///@" D ^DIE
K ^TMP("PSOPRVKY",$J),^TMP("PSOPUBKY",$J)
Q
;
OPENSSH() ; Returns the SSH Public Key in OpenSSH Format (Converts if necessary)
;Input: ^TMP("PSOPUBKY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
; ^TMP("PSOPUBKY",$J,1-N)=[SSH Key Content]
N OPENSSH,ENCRTYPE,LINE
S OPENSSH=""
I $P($G(^TMP("PSOPUBKY",$J,0)),"^",1)="SSH2" D
. S ENCRTYPE=$P($G(^TMP("PSOPUBKY",$J,0)),"^",2),OPENSSH=""
. F LINE=5:1 Q:'$D(^TMP("PSOPUBKY",$J,LINE)) D
. . I $G(^TMP("PSOPUBKY",$J,LINE))["---- END" Q
. . S OPENSSH=OPENSSH_$G(^TMP("PSOPUBKY",$J,LINE))
. S OPENSSH=$S(ENCRTYPE="RSA":"ssh-rsa",1:"ssh-dss")_" "_OPENSSH
E D
. F LINE=1:1 Q:'$D(^TMP("PSOPUBKY",$J,LINE)) D
. . S OPENSSH=OPENSSH_$G(^TMP("PSOPUBKY",$J,LINE))
Q OPENSSH
;
BKENDOS() ; Returns the Backend Server Operating System (OS)
;Output: Backend Operating System (e.,g., "VMS", "UNIX")
N BKENDOS,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,I
K ^XTMP("PSOSPMKY",$J,"OS")
S BKENDOS="",ZTRTN="SETOS^PSOSPMKY("_$J_")",ZTIO=""
S ZTDESC="State Prescription Monitoring Program (SPMP) Backend Server OS Check"
S ZTDTH=$$NOW^XLFDT() D ^%ZTLOAD
F I=1:1:5 S BKENDOS=$G(^XTMP("PSOSPMKY",$J,"OS")) Q:BKENDOS'="" H 1
K ^XTMP("PSOSPMKY",$J,"OS")
Q $S(BKENDOS'="":BKENDOS,1:$$OS^%ZOSV())
;
SETOS(JOB) ; Sets the Operating Systems in ^XTMP("PSOSPMKY",$J,"OS") (Called via Taskman)
;Input: JOB - $Job value from calling process
S ^XTMP("PSOSPMKY",JOB,"OS")=$$OS^%ZOSV()
Q
;
HELP ; SSH Key Help Text
W !!,"Secure SHell (SSH) Encryption Keys are used to automate the data transmission"
W !,"to the State Prescription Monitoring Programs (SPMPs). Follow the steps below"
W !,"to successfully setup SPMP transmissions from VistA to the state/vendor server:"
W !,""
W !,"Step 1: Select the 'N' (Create New SSH Key Pair) Action and follow the prompts"
W !," to create a new pair of SSH keys. If you already have an existing SSH"
W !," Key Pair you can skip this step. You can check whether you already"
W !," have an existing SSH Key Pair through the 'V' (View Public SSH Key)"
W !," Action."
W !,""
;PSO*7*723 add ECDSA
W !," Encryption Type: DSA, RSA, ECDSA or EDDSA?"
W !," -----------------------------------"
D ETHELP,PAUSE^PSOSPMU1
W !!,"Step 2: Share the Public SSH Key content with the state/vendor. In order to"
W !," successfully establish SPMP transmissions the state/vendor will have"
W !," to install/configure the new SSH Key created in step 1 for the"
W !," user id they assigned to your site. Use the 'V' (View Public SSH Key)"
W !," Action to retrieve the content of the Public SSH key. The Public SSH"
W !," Key should not contain line-feed characters, therefore after you copy"
W !," & paste it from the terminal emulator into an email or text editor"
W !," make sure it contains only one line of text (no wrapping)."
Q
ETHELP ; Encryption Type Help
W !," Digital Signature Algorithm (DSA) (No longer supported) and Rivest,"
w !," Shamir & Adleman (RSA) have been two of the most common encryption"
W !," algorithms used by the IT industry for securely sharing data. "
;PSO*7*723 add ECDSA/EDDSA
W !," Elliptic Curve Digital Signature Algorithm (ECDSA) and Edward-curve"
W !," Digital Signature Algorithm (EDDSA) are more complex public key"
W !," cryptography encryption algorithms that are now supported by the VA."
W !," Many of SPMP servers can handle all types; however there are vendors"
W !," that accept only one specific type. You will need to contact the SPMP"
W !," vendor support to determine which type to select. If ECDSA is selected"
W !," you will be prompted to enter the Bit size. Valid selections are 256,"
W !," 384 or 521."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMKY 13132 printed Sep 23, 2025@20:11:27 Page 2
PSOSPMKY ;BIRM/MFR - State Prescription Monitoring Program - SSH Key Management ;01/06/16
+1 ;;7.0;OUTPATIENT PHARMACY;**451,625,723**;DEC 1997;Build 13
+2 ;
EN ; Entry-point
+1 NEW STATEIEN,DIC,X,Y,DUOUT,DTOUT,PSOOS,LOCALDIR,X1,DIR,DIRUT,LOCALDIR
+2 WRITE !
KILL DIC
SET DIC("A")="Select STATE: "
SET DIC="^PS(58.41,"
SET DIC(0)="QOEAM"
+3 IF $ORDER(^PS(58.41,0))
SET DIC("B")=$ORDER(^PS(58.41,0))
+4 DO ^DIC
IF X=""!(X="^")!$DATA(DUOUT)!$DATA(DTOUT)
GOTO END
+5 KILL DIC("A")
if Y<0
GOTO EN
SET STATEIEN=+Y
+6 ;
ACTION ; SSH Key Action
+1 KILL DIR
SET DIR("A")="Action"
+2 SET DIR(0)="S^V:View Public SSH Key;N:Create New SSH Key Pair;"
+3 SET DIR(0)=DIR(0)_"D:Delete SSH Key Pair;H:Help with SSH Keys"
+4 SET DIR("B")="V"
DO ^DIR
IF $DATA(DUOUT)!($DATA(DIRUT))
GOTO END
+5 IF Y="N"!(Y="D")
IF '$DATA(^XUSEC("PSO SPMP ADMIN",DUZ))
Begin DoDot:1
+6 WRITE !!,"The PSO SPMP ADMIN security key is required for this action.",$CHAR(7)
End DoDot:1
GOTO ACTION
+7 KILL ^TMP("PSOPUBKY",$JOB)
DO RETRIEVE(STATEIEN,"PUB")
+8 IF Y="V"!(Y="D")
IF '$DATA(^TMP("PSOPUBKY",$JOB))
Begin DoDot:1
+9 WRITE !!,"[No SSH Key Pair found for ",$$GET1^DIQ(5,STATEIEN,.01),"]",$CHAR(7)
DO PAUSE^PSOSPMU1
End DoDot:1
GOTO ACTION
+10 IF Y="N"!(Y="D")
DO SIG^XUSESIG
IF X="^"!($GET(X1)="")
if $GET(X1)=""
WRITE " SIGNATURE NOT VERIFIED",$CHAR(7)
GOTO ACTION
+11 ;
+12 ; View Public SSH Key
+13 IF Y="V"
Begin DoDot:1
+14 WRITE !
DO VIEW(STATEIEN)
DO PAUSE^PSOSPMU1
End DoDot:1
GOTO ACTION
+15 ;
+16 ; Create New SSH Key Pair
+17 IF Y="N"
Begin DoDot:1
+18 SET PSOOS=$$BKENDOS()
+19 SET LOCALDIR=$$GET1^DIQ(58.41,STATEIEN,$SELECT(PSOOS["VMS":4,1:15))
+20 IF LOCALDIR=""
Begin DoDot:2
+21 WRITE !!,"The ",$SELECT(PSOOS["VMS":"OPEN VMS",1:"UNIX/LINUX")," LOCAL DIRECTORY parameter is missing for ",$$GET1^DIQ(5,STATEIEN,.01),". Please,"
+22 WRITE !,"update it in the View/Edit SPMP State Parameters option and try again.",$CHAR(7)
DO PAUSE^PSOSPMU1
End DoDot:2
QUIT
+23 KILL DIR
SET DIR("A")="SSH Key Encryption Type"
SET DIR("?")="^D ETHELP^PSOSPMKY"
+24 ;p723
SET DIR(0)="S^RSA:Rivest, Shamir & Adleman (RSA);DSA:Digital Signature Algorithm (DSA);ECDSA:Elliptic Curve Digital Signature Algorithm (ECDSA);EDDSA:Edward-curve Digital Signature Algorithm (ed25519)"
+25 SET DIR("B")="RSA"
DO ^DIR
IF $DATA(DUOUT)!($DATA(DIRUT))
QUIT
+26 SET ENCRTYPE=Y
IF Y="DSA"
Begin DoDot:2
+27 WRITE !!,$GET(IOBON),"WARNING:",$GET(IOBOFF)," 'DSA' SSH keys are being phased out and are no longer supported.",$CHAR(7)
End DoDot:2
QUIT
+28 ;p723 prompt for bit size for ECDSA
+29 IF ENCRTYPE="ECDSA"
Begin DoDot:2
+30 KILL DIR
SET DIR("A")="ECDSA encryption key size (bit size)"
SET DIR("?")="Available key sizes are 256 bits, 384 bits, or 521 bits. Also referred to as key length."
+31 SET DIR(0)="S^256:256 bits;384:384 bits;521:521 bits"
+32 SET DIR("B")="256"
DO ^DIR
End DoDot:2
IF $DATA(DUOUT)!($DATA(DIRUT))
QUIT
+33 SET ENCRBITS=$SELECT(ENCRTYPE="ECDSA":Y,1:"")
+34 IF $DATA(^TMP("PSOPUBKY",$JOB))
Begin DoDot:2
+35 WRITE !!,$GET(IOBON),"WARNING:",$GET(IOBOFF)," You may be overwriting SSH Keys that are currently in use.",$CHAR(7)
End DoDot:2
+36 KILL DIR
SET DIR("A")="Confirm Creation of SSH "_ENCRTYPE_" Keys for "_$$GET1^DIQ(5,STATEIEN,.01)
SET DIR(0)="Y"
SET DIR("B")="NO"
+37 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DUOUT)!'Y
QUIT
+38 ; Deleting Existing SSH Key
+39 IF $DATA(^TMP("PSOPUBKY",$JOB))
DO DELETE(STATEIEN)
+40 WRITE !!,"Creating New SSH Keys, please wait..."
+41 ;p723 removing the task off logic, unnecessary
+42 ;N ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK
+43 ;S ZTRTN="NEWKEY^PSOSPMKY("_STATEIEN_","""_ENCRTYPE_""")"
+44 ;S ZTDESC="State Prescription Monitoring Program (SPMP) SSH Key Generation"
+45 ;S ZTDTH=$$NOW^XLFDT() D ^%ZTLOAD K ZTSK
+46 ;K ^TMP("PSOPUBKY",$J)
+47 ;F I=1:1:30 D RETRIEVE(STATEIEN,"PUB") Q:$D(^TMP("PSOPUBKY",$J)) H 1
+48 ; If unable to create the key via Taskman after 30 seconds, creates them in the foreground
+49 ;I '$D(^TMP("PSOPUBKY",$J)) D
+50 ;p723 pass ENCRBITS
DO NEWKEY(STATEIEN,ENCRTYPE,ENCRBITS)
DO RETRIEVE(STATEIEN,"PUB")
+51 IF '$DATA(^TMP("PSOPUBKY",$JOB))
Begin DoDot:2
+52 WRITE !!,"There was a problem with the generation of the new SSH Key Pair."
+53 WRITE !,"Please try again and if the problem persists contact IT Support.",$CHAR(7)
DO PAUSE^PSOSPMU1
End DoDot:2
+54 IF '$TEST
WRITE "Done",$CHAR(7)
End DoDot:1
GOTO ACTION
+55 KILL ENCRBITS
+56 ;
+57 ; Delete SSH Key Pair
+58 IF Y="D"
Begin DoDot:1
+59 DO RETRIEVE(STATEIEN,"PUB")
+60 IF '$DATA(^TMP("PSOPUBKY",$JOB))
Begin DoDot:2
+61 WRITE !!,"[No SSH Key Pair found for ",$$GET1^DIQ(5,STATEIEN,.01),"]",$CHAR(7)
End DoDot:2
QUIT
+62 WRITE !!,$GET(IOBON),"WARNING:",$GET(IOBOFF)," You may be deleting SSH Keys that are currently in use.",$CHAR(7)
+63 KILL DIR
SET DIR("A")="Confirm Deletion of "_$$GET1^DIQ(5,STATEIEN,.01)_"'s SSH Keys"
SET DIR(0)="Y"
SET DIR("B")="NO"
+64 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DUOUT)!'Y
QUIT
+65 WRITE !!,"Deleting SSH Keys..."
DO DELETE(STATEIEN)
HANG 1
WRITE "Done",$CHAR(7)
End DoDot:1
GOTO ACTION
+66 ;
+67 ; SSH Key Help
+68 IF Y="H"
DO HELP
GOTO ACTION
+69 ;
+70 GOTO ACTION
+71 ;
END QUIT
+1 ;
NEWKEY(STATEIEN,ENCRTYPE,ENCRBITS) ; Generate and store a pair of SSH keys for a specific state
+1 ; Input: (r) STATEIEN - State that will be using the new key pair. Pointer to the STATE file (#5)
+2 ; (o) ENCRTYPE - SSH Encryption Type (DSA / RSA) (Default: RSA)
+3 NEW LOCALDIR,DATETIME,PSOOS,KEYFILE,PV,FILE2DEL,LINE,OVFLINE,NMSPC,KEYTXT,SAVEKEY,DIE,DR,DA
+4 ;
+5 ;Error: State missing
IF '$GET(STATEIEN)
QUIT
+6 SET PSOOS=$$OS^%ZOSV()
+7 ;Error: Missing directory
SET LOCALDIR=$$GET1^DIQ(58.41,STATEIEN,$SELECT(PSOOS["VMS":4,1:15))
IF LOCALDIR=""
QUIT
+8 ;I $G(ENCRTYPE)'="DSA",$G(ENCRTYPE)'="RSA" S ENCRTYPE="RSA"
+9 SET ENCRTYPE=$SELECT($GET(ENCRTYPE)="ECDSA":"ECDSA",$GET(ENCRTYPE)="EDDSA":"ed25519",1:"RSA")
+10 ;
+11 ; LOCK to avoid OS files overwrite
+12 FOR
SET DATETIME=$PIECE($$FMTHL7^XLFDT($$HTFM^XLFDT($HOROLOG)),"-")
SET KEYFILE="KEY"_DATETIME
LOCK +@KEYFILE:0
if $TEST
QUIT
HANG 2
+13 ;
+14 ; Deleting existing SSH Keys first
+15 DO DELETE(STATEIEN)
+16 ;
+17 ; OpenVMS SSH Key Generation
+18 IF PSOOS["VMS"
Begin DoDot:1
+19 NEW COMFILE
+20 SET COMFILE="COM"_DATETIME_".COM"
+21 DO OPEN^%ZISH("COMFILE",LOCALDIR,COMFILE,"W")
+22 DO USE^%ZISUTL("COMFILE")
+23 WRITE "SSH_KEYGEN == ""$SYS$SYSTEM:TCPIP$SSH_SSH-KEYGEN2.EXE""",!
+24 WRITE "SSH_KEYGEN -t "_$$LOW^XLFSTR($GET(ENCRTYPE))_" -""P"" "_LOCALDIR_KEYFILE,!
+25 DO CLOSE^%ZISH("COMFILE")
+26 XECUTE "S PV=$ZF(-1,""@"_LOCALDIR_COMFILE_""")"
+27 SET FILE2DEL(COMFILE)=""
SET FILE2DEL(KEYFILE_".")=""
SET FILE2DEL(KEYFILE_".PUB")=""
End DoDot:1
+28 ;
+29 ; Linux/Unix SSH Key Generation
+30 IF PSOOS["UNIX"
Begin DoDot:1
+31 IF '$$DIREXIST^PSOSPMU1(LOCALDIR)
DO MAKEDIR^PSOSPMU1(LOCALDIR)
+32 SET ENCRBITS=$SELECT($GET(ENCRBITS):" -b "_ENCRBITS,1:"")
+33 XECUTE "S PV=$ZF(-1,""ssh-keygen -q -N '' -C '' -t "_$$LOW^XLFSTR($GET(ENCRTYPE))_" -f "_LOCALDIR_KEYFILE_ENCRBITS_""")"
+34 SET FILE2DEL(KEYFILE)=""
SET FILE2DEL(KEYFILE_".pub")=""
End DoDot:1
+35 ;
+36 KILL ^TMP("PSOPRVKY",$JOB),^TMP("PSOPUBKY",$JOB)
+37 ; Retrieving SSH Private Key Content
+38 SET X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$SELECT(PSOOS["VMS":".",1:""),$NAME(^TMP("PSOPRVKY",$JOB,1)),3)
+39 IF '$DATA(^TMP("PSOPRVKY",$JOB,1))
QUIT
+40 ; Retrieving SSH Public Key Content
+41 SET X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$SELECT(PSOOS["VMS":".PUB",1:".pub"),$NAME(^TMP("PSOPUBKY",$JOB,1)),3)
+42 IF '$DATA(^TMP("PSOPUBKY",$JOB,1))
QUIT
+43 ;
+44 ; Deleting temporary files used to generate the keys
+45 DO DEL^%ZISH(LOCALDIR,"FILE2DEL")
+46 ;
+47 ; Saving new SSH Keys content in the SPMP STATE PARAMETERS file (#58.41)
+48 FOR NMSPC="PSOPRVKY","PSOPUBKY"
Begin DoDot:1
+49 KILL KEYTXT,SAVEKEY
+50 FOR LINE=1:1
if '$DATA(^TMP(NMSPC,$JOB,LINE))
QUIT
Begin DoDot:2
+51 ; Unix/Linux Public SSH Key has no line-feed (one long line)
+52 IF PSOOS["UNIX"
IF NMSPC="PSOPUBKY"
Begin DoDot:3
+53 SET KEYTXT(1)=^TMP(NMSPC,$JOB,LINE)
+54 FOR OVFLINE=1:1
if '$DATA(^TMP(NMSPC,$JOB,LINE,"OVF",OVFLINE))
QUIT
Begin DoDot:4
+55 SET KEYTXT(1)=$GET(KEYTXT(1))_^TMP(NMSPC,$JOB,LINE,"OVF",OVFLINE)
End DoDot:4
End DoDot:3
QUIT
+56 SET KEYTXT(LINE)=$$ENCRYP^XUSRB1(^TMP(NMSPC,$JOB,LINE))
End DoDot:2
+57 IF PSOOS["UNIX"
IF NMSPC="PSOPUBKY"
SET KEYTXT(1)=$$ENCRYP^XUSRB1(KEYTXT(1))
+58 SET SAVEKEY(58.41,STATEIEN_",",$SELECT(NMSPC="PSOPRVKY":100,1:200))="KEYTXT"
+59 DO UPDATE^DIE("","SAVEKEY")
+60 KILL ^TMP(NMSPC,$JOB)
End DoDot:1
+61 ;
+62 ; Saving SSH Key Format (SSH2/OpenSSH) and Encryption Type (DSA/RSA) fields
+63 KILL DIE
SET DIE="^PS(58.41,"
SET DA=STATEIEN
+64 SET DR="18///"_$SELECT(PSOOS["VMS":"SSH2",1:"OSSH")_";19////"_ENCRTYPE
DO ^DIE
+65 ;
+66 LOCK -@KEYFILE
+67 QUIT
+68 ;
RETRIEVE(STATEIEN,KEYTYPE) ; Retrieve the SSH Key into the ^TMP global
+1 ; Input: (r) STATEIEN - State to retrieve the SSH Key from
+2 ; (o) KEYTYPE - SSH Key Type (PUB - Public / PRV - PRivate) (Default: Public)
+3 ;Output: ^TMP("PSO[PUB/PRV]KY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
+4 ; ^TMP("PSO[PUB/PRV]KY",$J,1-N)=[SSH Key Content]
+5 NEW X,LINE,KEYTXT,NMSPC
+6 IF $GET(KEYTYPE)'="PUB"
IF $GET(KEYTYPE)'="PRV"
SET KEYTYPE="PUB"
+7 SET X=$$GET1^DIQ(58.41,STATEIEN_",",$SELECT(KEYTYPE="PRV":100,1:200),,"KEYTXT")
+8 SET NMSPC=$SELECT(KEYTYPE="PRV":"PSOPRVKY",1:"PSOPUBKY")
+9 KILL ^TMP(NMSPC,$JOB)
+10 FOR LINE=1:1
if '$DATA(KEYTXT(LINE))
QUIT
Begin DoDot:1
+11 SET ^TMP(NMSPC,$JOB,LINE)=$$DECRYP^XUSRB1(KEYTXT(LINE))
End DoDot:1
+12 IF $DATA(^TMP(NMSPC,$JOB))
Begin DoDot:1
+13 SET ^TMP(NMSPC,$JOB,0)=$$GET1^DIQ(58.41,STATEIEN,18,"I")_"^"_$$GET1^DIQ(58.41,STATEIEN,19,"I")
End DoDot:1
+14 QUIT
+15 ;
VIEW(STATEIEN) ; Displays the SSH Public Key
+1 ;Input: (r) STATEIEN - State to display the Public SSH Key for
+2 ; ^TMP("PSOPUBKY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
+3 ; ^TMP("PSOPUBKY",$J,1-N)=[SSH Key Content]
+4 NEW SSHKEY,DASHLN
+5 IF '$GET(STATEIEN)
QUIT
+6 SET SSHKEY=$$OPENSSH()
SET $PIECE(DASHLN,"-",81)=""
+7 WRITE !,$$GET1^DIQ(5,STATEIEN,.01),"'s Public SSH Key (",$PIECE($GET(^TMP("PSOPUBKY",$JOB,0)),"^",2),") content (does not include dash lines):"
+8 WRITE !,DASHLN
+9 FOR
if $LENGTH(SSHKEY)=0
QUIT
WRITE !,$EXTRACT(SSHKEY,1,80)
SET SSHKEY=$EXTRACT(SSHKEY,81,9999)
+10 WRITE !,DASHLN
+11 QUIT
+12 ;
DELETE(STATEIEN) ; Delete Both SSH Keys associated with the State
+1 ;Input: (r) STATEIEN - State from what the key should be deleted from in the SPMP STATE PARAMETERS file (#58.41)
+2 NEW DIE,DA,DR
+3 SET DIE="^PS(58.41,"
SET DA=+$GET(STATEIEN)
SET DR="18///@;19///@;100///@;200///@"
DO ^DIE
+4 KILL ^TMP("PSOPRVKY",$JOB),^TMP("PSOPUBKY",$JOB)
+5 QUIT
+6 ;
OPENSSH() ; Returns the SSH Public Key in OpenSSH Format (Converts if necessary)
+1 ;Input: ^TMP("PSOPUBKY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
+2 ; ^TMP("PSOPUBKY",$J,1-N)=[SSH Key Content]
+3 NEW OPENSSH,ENCRTYPE,LINE
+4 SET OPENSSH=""
+5 IF $PIECE($GET(^TMP("PSOPUBKY",$JOB,0)),"^",1)="SSH2"
Begin DoDot:1
+6 SET ENCRTYPE=$PIECE($GET(^TMP("PSOPUBKY",$JOB,0)),"^",2)
SET OPENSSH=""
+7 FOR LINE=5:1
if '$DATA(^TMP("PSOPUBKY",$JOB,LINE))
QUIT
Begin DoDot:2
+8 IF $GET(^TMP("PSOPUBKY",$JOB,LINE))["---- END"
QUIT
+9 SET OPENSSH=OPENSSH_$GET(^TMP("PSOPUBKY",$JOB,LINE))
End DoDot:2
+10 SET OPENSSH=$SELECT(ENCRTYPE="RSA":"ssh-rsa",1:"ssh-dss")_" "_OPENSSH
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 FOR LINE=1:1
if '$DATA(^TMP("PSOPUBKY",$JOB,LINE))
QUIT
Begin DoDot:2
+13 SET OPENSSH=OPENSSH_$GET(^TMP("PSOPUBKY",$JOB,LINE))
End DoDot:2
End DoDot:1
+14 QUIT OPENSSH
+15 ;
BKENDOS() ; Returns the Backend Server Operating System (OS)
+1 ;Output: Backend Operating System (e.,g., "VMS", "UNIX")
+2 NEW BKENDOS,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,I
+3 KILL ^XTMP("PSOSPMKY",$JOB,"OS")
+4 SET BKENDOS=""
SET ZTRTN="SETOS^PSOSPMKY("_$JOB_")"
SET ZTIO=""
+5 SET ZTDESC="State Prescription Monitoring Program (SPMP) Backend Server OS Check"
+6 SET ZTDTH=$$NOW^XLFDT()
DO ^%ZTLOAD
+7 FOR I=1:1:5
SET BKENDOS=$GET(^XTMP("PSOSPMKY",$JOB,"OS"))
if BKENDOS'=""
QUIT
HANG 1
+8 KILL ^XTMP("PSOSPMKY",$JOB,"OS")
+9 QUIT $SELECT(BKENDOS'="":BKENDOS,1:$$OS^%ZOSV())
+10 ;
SETOS(JOB) ; Sets the Operating Systems in ^XTMP("PSOSPMKY",$J,"OS") (Called via Taskman)
+1 ;Input: JOB - $Job value from calling process
+2 SET ^XTMP("PSOSPMKY",JOB,"OS")=$$OS^%ZOSV()
+3 QUIT
+4 ;
HELP ; SSH Key Help Text
+1 WRITE !!,"Secure SHell (SSH) Encryption Keys are used to automate the data transmission"
+2 WRITE !,"to the State Prescription Monitoring Programs (SPMPs). Follow the steps below"
+3 WRITE !,"to successfully setup SPMP transmissions from VistA to the state/vendor server:"
+4 WRITE !,""
+5 WRITE !,"Step 1: Select the 'N' (Create New SSH Key Pair) Action and follow the prompts"
+6 WRITE !," to create a new pair of SSH keys. If you already have an existing SSH"
+7 WRITE !," Key Pair you can skip this step. You can check whether you already"
+8 WRITE !," have an existing SSH Key Pair through the 'V' (View Public SSH Key)"
+9 WRITE !," Action."
+10 WRITE !,""
+11 ;PSO*7*723 add ECDSA
+12 WRITE !," Encryption Type: DSA, RSA, ECDSA or EDDSA?"
+13 WRITE !," -----------------------------------"
+14 DO ETHELP
DO PAUSE^PSOSPMU1
+15 WRITE !!,"Step 2: Share the Public SSH Key content with the state/vendor. In order to"
+16 WRITE !," successfully establish SPMP transmissions the state/vendor will have"
+17 WRITE !," to install/configure the new SSH Key created in step 1 for the"
+18 WRITE !," user id they assigned to your site. Use the 'V' (View Public SSH Key)"
+19 WRITE !," Action to retrieve the content of the Public SSH key. The Public SSH"
+20 WRITE !," Key should not contain line-feed characters, therefore after you copy"
+21 WRITE !," & paste it from the terminal emulator into an email or text editor"
+22 WRITE !," make sure it contains only one line of text (no wrapping)."
+23 QUIT
ETHELP ; Encryption Type Help
+1 WRITE !," Digital Signature Algorithm (DSA) (No longer supported) and Rivest,"
+2 WRITE !," Shamir & Adleman (RSA) have been two of the most common encryption"
+3 WRITE !," algorithms used by the IT industry for securely sharing data. "
+4 ;PSO*7*723 add ECDSA/EDDSA
+5 WRITE !," Elliptic Curve Digital Signature Algorithm (ECDSA) and Edward-curve"
+6 WRITE !," Digital Signature Algorithm (EDDSA) are more complex public key"
+7 WRITE !," cryptography encryption algorithms that are now supported by the VA."
+8 WRITE !," Many of SPMP servers can handle all types; however there are vendors"
+9 WRITE !," that accept only one specific type. You will need to contact the SPMP"
+10 WRITE !," vendor support to determine which type to select. If ECDSA is selected"
+11 WRITE !," you will be prompted to enter the Bit size. Valid selections are 256,"
+12 WRITE !," 384 or 521."
+13 QUIT
