PSNFTP2 ;HP/ART - PPS-N National Drug File Updates File Transfer ;09/25/2015
;;4.0;NATIONAL DRUG FILE;**513,573**; 30 Oct 98;Build 6
;Supported ICRs/IAs
;External reference to ^%ZISH supported by DBIA 2320
;External reference to ^%ZISUTL supported by DBIA 2119
;External reference to ^XLFSTR supported by DBIA 10104
;Reference to ^PS(59.7 supported by DBIA 2613
;
VMSFTP(PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCOMFIL,PSLOGFIL,PSDATFIL,PSERRMSG) ; VMS FTP
; ALL PARARMETERS ARE REQUIRED EXCEPT PASSWORD
;Inputs: PSRC - return code, by reference
; PSADDR - remote server address
; PSNUSER - target system user name
; PSWRKDIR - local work directory name
; PSLOCDIR - local directory name
; PSREMDIR - remote directory name
; PSREMFIL - remote file name
; PSCOMFIL - ftp .com file name
; PSLOGFIL - ftp log file name
; PSDATFIL - sftp commands file name
;Output: PSRC - populated return code
;
;check parameters
I $G(PSADDR)="" S PSRC="0^no target server address" Q
I $G(PSNUSER)="" S PSRC="0^no user name" Q
I $G(PSWRKDIR)="" S PSRC="0^no local work directory name" Q
I $G(PSLOCDIR)="" S PSRC="0^no local directory name" Q
I $G(PSREMDIR)="" S PSRC="0^no remote directory name" Q
I $G(PSREMFIL)="" S PSRC="0^no remote file name" Q
I $G(PSCOMFIL)="" S PSRC="0^no ftp .com file name" Q
I $G(PSLOGFIL)="" S PSRC="0^no ftp log file name" Q
I $G(PSDATFIL)="" S PSRC="0^no sftp commands file name" Q
;
;create .dat file with sftp commands
D CREATDAT^PSNFTP(.PSRC,PSDATFIL,PSWRKDIR,PSREMDIR,PSREMFIL) Q:'+PSRC
;
;create .com file
N POP,FTPPORT S FTPPORT=""
D OPEN^%ZISH("FILE1",PSWRKDIR,PSCOMFIL,"W")
I POP S PSRC="0^failed to open ftp .com file" Q
D USE^%ZISUTL("FILE1")
W "$ set verify=(PROCEDURE,IMAGE)",!
W "$ set default ",PSLOCDIR,!
W "$ sftp"_$S(FTPPORT:" -oPort="_FTPPORT,1:"")_" -oIdentityFile="""_$$XVMSDIR(PSWRKDIR)_"VSSHID."" -""B"" "_PSWRKDIR_PSDATFIL_" -oUser="_PSNUSER_" "_PSADDR,!
W "$ exit",!
D CLOSE^%ZISH("FILE1")
;
D OPEN^%ZISH("VSSHID",PSWRKDIR,"VSSHID.","W")
I POP S PSRC="-1^FTP Script file <"_PSWRKDIR_"VSSHID.> could not be created." Q
D USE^%ZISUTL("VSSHID")
W "IDKEY "_$$XVMSDIR(PSWRKDIR)_"VSSHKEY"
D CLOSE^%ZISH("VSSHID")
;
EXECUTE ;Execute .COM file, create logfile
N PSZFRC
S PSZFRC=$ZF(-1,"@"_PSWRKDIR_PSCOMFIL_"/OUTPUT="_PSWRKDIR_PSLOGFIL)
; Error check
I PSZFRC=-1 S PSRC="0^VMS OS command execution failed" Q
;
; Read Logfile into working global
K ^TMP("PSNFTPLOG",$J)
N PSXLOG
S PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NA(^TMP("PSNFTPLOG",$J,1)),3)
; Check for error during ftp
N PSPNG,PSPNG1,PSSTOP
S PSPNG="",PSPNG1=0,PSSTOP=0
F S PSPNG=$O(^TMP("PSNFTPLOG",$J,PSPNG)) Q:PSPNG=""!PSSTOP D
. S PSPNG1=$G(^TMP("PSNFTPLOG",$J,PSPNG))
. I PSPNG1["%TCPIP-E-SSH_FC_ERR_NO_S, file doesn't exist" S PSRC="0^Remote file was not found",PSSTOP=1 Q
. I PSPNG1["%TCPIP-F-SSH_FATAL" S PSRC="0^non-specific fatal error",PSSTOP=1 Q
. I PSPNG1["530 Login incorrect" S PSRC="0^server login failure",PSSTOP=1 Q
. I PSPNG1["550-Failed to open" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["550 file not found" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["no such file" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["No such file" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["error processing output file" S PSRC="-1^remote file already downloaded",PSSTOP=1 Q
. I PSPNG1["insufficient privilege" S PSRC="-1^remote file already downloaded",PSSTOP=1 Q
. I PSPNG1["%SET-F-SEARCHFAIL" S PSRC="0^local file not found - change file permission",PSSTOP=1 Q
. I PSPNG1["%TCPIP-E-SSH_FC_ERR_DEST" S PSRC="0^destination is not directory or does not exist",PSSTOP=1 Q
. I PSPNG1["%TCPIP-E-SSH_FC_ERROR" S PSRC="0^destination is not directory or does not exist",PSSTOP=1 Q
I PSSTOP=0 S PSERRMSG(1)="1^File Transfer is complete"
D DELFILES($G(PSWRKDIR),$G(PSLOGFIL),$G(PSCOMFIL),$G(PSDATFIL))
Q
;
LINUXFTP(PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSSHFILE,PSLOGFIL,PSDATFIL) ; Linux FTP
; ALL PARARMETERS ARE REQUIRED EXCEPT PASSWORD
;Inputs: PSRC - return code, by reference
; PSADDR - remote server address
; PSNUSER - target system user name
; PSWRKDIR - local work directory name
; PSLOCDIR - local directory name
; PSREMDIR - remote directory name
; PSREMFIL - remote file name
; PSSHFILE - ftp .sh file name
; PSLOGFIL - ftp log file name
; PSDATFIL - sftp commands file name
;Output: PSRC - populated return code
;
;check parameters
I $G(PSADDR)="" S PSRC="0^no target server address" Q
I $G(PSNUSER)="" S PSRC="0^no user name" Q
I $G(PSWRKDIR)="" S PSRC="0^no local work directory name" Q
I $G(PSLOCDIR)="" S PSRC="0^no local directory name" Q
I $G(PSREMDIR)="" S PSRC="0^no remote directory name" Q
I $G(PSREMFIL)="" S PSRC="0^no remote file name" Q
I $G(PSSHFILE)="" S PSRC="0^no ftp .sh file name" Q
I $G(PSLOGFIL)="" S PSRC="0^no ftp log file name" Q
I $G(PSDATFIL)="" S PSRC="0^no sftp commands file name" Q
;
;create .dat file with sftp commands
D CREATDAT^PSNFTP(.PSRC,PSDATFIL,PSWRKDIR,PSREMDIR,PSREMFIL) Q:'+PSRC
;create .sh file
N POP,DEBUG1 S DEBUG1=1
D OPEN^%ZISH("FILE1",PSWRKDIR,PSSHFILE,"W")
I POP S PSRC="0^failed to open ftp .sh file" Q
D USE^%ZISUTL("FILE1")
; Linux .sh commands
W "#!/bin/bash",!!
W "cd ",PSWRKDIR,!
W "sftp"_" -oIdentityFile="""""_PSWRKDIR_"uxsshkey"""" -b "_PSWRKDIR_PSDATFIL_" -oStrictHostKeyChecking=no -oUser="_PSNUSER_" "_PSADDR_" >> "_PSWRKDIR_PSLOGFIL
W !,"exit",!
D CLOSE^%ZISH("FILE1")
;
; Execute .sh file, create logfile
N PSZFRC
S PSZFRC=$ZF(-1,PSWRKDIR_PSSHFILE_" >"_PSWRKDIR_PSLOGFIL)
; Error check
I PSZFRC=-1 S PSRC="0^Linux OS command execution failed" Q
;
; Read Logfile into working global
K ^TMP("PSNFTPLOG",$J)
N PSXLOG
S PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NA(^TMP("PSNFTPLOG",$J,1)),3)
; Check for error during ftp
N PSPNG,PSPNG1,PSSTOP,UXEXIT
S PSPNG="",(PSPNG1,PSSTOP,UXEXIT)=0
F S PSPNG=$O(^TMP("PSNFTPLOG",$J,PSPNG)) Q:PSPNG=""!PSSTOP D
. S PSPNG1=$G(^TMP("PSNFTPLOG",$J,PSPNG))
. I $$UP^XLFSTR(PSPNG1)["SFTP> EXIT" S UXEXIT=1 Q
. I PSPNG1["425 Not logged in" S PSRC="0^Login incorrect",PSSTOP=1 Q
. I PSPNG1["530 Login incorrect" S PSRC="0^Login incorrect",PSSTOP=1 Q
. I PSPNG1["550-Failed to open" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["550 file not found" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["no such file" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["No such file" S PSRC="-1^remote file not found",PSSTOP=1 Q
I UXEXIT=0 S PSRC="-1^Remote file was not found",PSSTOP=1 Q
I PSSTOP=0,UXEXIT S PSERRMSG(1)="1^File Transfer is complete"
D DELFILES($G(PSWRKDIR),$G(PSLOGFIL),$G(PSCOMFIL),$G(PSDATFIL))
Q
;
WINFTP(PSRC,PSADDR,PSUID,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCMDFIL,PSLOGFIL) ; Windows FTP
; ALL PARARMETERS ARE REQUIRED EXCEPT PASSWORD
;Inputs: PSRC - return code, by reference
; PSADDR - remote server address
; PSUID - target system user name
; PSWRKDIR - local work directory name
; PSLOCDIR - local directory name
; PSREMDIR - remote directory name
; PSREMFIL - remote file name
; PSCMDFIL - ftp commands file name
; PSLOGFIL - ftp log file name
;Output: PSRC - populated return code
;
;check parameters
I $G(PSADDR)="" S PSRC="0^no target server address" Q
I $G(PSUID)="" S PSRC="0^no user name" Q
I $G(PSWRKDIR)="" S PSRC="0^no local work directory name" Q
I $G(PSLOCDIR)="" S PSRC="0^no local directory name" Q
I $G(PSREMDIR)="" S PSRC="0^no remote directory name" Q
I $G(PSREMFIL)="" S PSRC="0^no remote file name" Q
I $G(PSCMDFIL)="" S PSRC="0^no ftp commands file name" Q
I $G(PSLOGFIL)="" S PSRC="0^no ftp log file name" Q
;create ftp commands file
N POP
D OPEN^%ZISH("FILE1",PSWRKDIR,PSCMDFIL,"W")
I POP S PSRC="0^failed to open ftp commands file" Q
D USE^%ZISUTL("FILE1")
W "open ",PSADDR,!
W PSUID,!
W "lcd ",PSLOCDIR,!
W "cd ",PSREMDIR,!
W "ascii",!
W "get ",PSREMFIL,!
W "quit",!
D CLOSE^%ZISH("FILE1")
; Execute ftp file, create logfile
N PSZFRC
S PSZFRC=$ZF(-1,"sftp -s:"_PSWRKDIR_PSCMDFIL_" >"_PSWRKDIR_PSLOGFIL)
; Error check
I PSZFRC=-1 S PSRC="0^Windows OS command execution failed" Q
; Read Logfile into working global
K ^TMP("PSNFTPLOG",$J)
N PSXLOG
S PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NA(^TMP("PSNFTPLOG",$J,1)),3)
; Check for error during ftp
N PSPNG,PSPNG1,PSSTOP
S PSPNG=""
S PSPNG1=0
S PSSTOP=0
F S PSPNG=$O(^TMP("PSNFTPLOG",$J,PSPNG)) Q:PSPNG=""!PSSTOP D
. S PSPNG1=$G(^TMP("PSNFTPLOG",$J,PSPNG))
. I PSPNG1["530 Login incorrect" S PSRC="0^Login incorrect",PSSTOP=1 Q
. I PSPNG1["425 Not logged in" S PSRC="0^Login incorrect",PSSTOP=1 Q
. I PSPNG1["550-Failed to open" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["550 file not found" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["no such file" S PSRC="-1^remote file not found",PSSTOP=1 Q
. I PSPNG1["No such file" S PSRC="-1^remote file not found",PSSTOP=1 Q
Q
;
FILSIZE(PSDIR,PSFILE,PSSIZE,PSNFLAG1) ;get the file size after retrieval
N PSDIR,PSFSIZL,PSFSIZL2,DIE,DA,D0,DR,PSXLOG,PSSEQ,PSSEQD,PSIEN,ERROR,PSOS,X
S PSOS=$$GETOS^PSNFTP
S:'$D(PSDIR) PSDIR=$$GETD^PSNFTP()
S PSFSIZL="PSFSIZE.LOG"
S X=$ZF(-1,"DIR/SIZE=UNITS=BYTES "_PSDIR_PSFILE,PSDIR_PSFSIZL)
S PSXLOG="",PSXLOG=$$FTG^%ZISH(PSDIR,PSFSIZL,$NA(^TMP("PSNFSIZELOG",$J,1)),3)
S (PSSEQ,PSSEQD,PSIEN,DIE,DR,DA)=""
F S PSSEQ=$O(^TMP("PSNFSIZELOG",$J,PSSEQ)) Q:PSSEQ="" D
. S PSSEQD=$G(^TMP("PSNFSIZELOG",$J,PSSEQ))
. I PSSEQD["Total of" S PSSIZE=$P(PSSEQD,",",2)
S PSFSIZL2="PSFSIZE2.LOG"
S X=$ZF(-1,"DIR/SIZE "_PSDIR_PSFILE,PSDIR_PSFSIZL2)
S PSXLOG="",PSXLOG=$$FTG^%ZISH(PSDIR,PSFSIZL2,$NA(^TMP("PSNFSIZELOG2",$J,1)),3)
S (PSSEQ,PSSEQD,PSIEN,DIE,DR,DA)=""
F S PSSEQ=$O(^TMP("PSNFSIZELOG2",$J,PSSEQ)) Q:PSSEQ="" D
. S PSSEQD=$G(^TMP("PSNFSIZELOG2",$J,PSSEQ))
. I PSSEQD["Total of" S PSSIZE=PSSIZE_" or"_$P($P(PSSEQD,",",2),".")
G:$G(PSNFLAG1) FILSIZQ
S PSIEN="",PSIEN=$O(^PS(57.23,1,4,"B",PSFILE_";1",PSIEN))
G FILSIZQ:PSIEN=""
I '$G(PSNFLAG1) S DIE="^PS(57.23,1,4,",DA=PSIEN,DR="3///"_PSSIZE D ^DIE
FILSIZQ ;
I '$G(PSOS) S PSOS=$$GETOS^PSNFTP
I PSOS["VMS" D
. D VMSDEL(1,PSDIR,PSFSIZL)
. D VMSDEL(1,PSDIR,PSFSIZL2)
K ^TMP("PSNFSIZELOG",$J)
Q
;
VMSDEL(PSRC,PSDIR,PSFILE) ;Delete Local Host File
;Inputs: PSRC - return code, by reference
; PSDIR - directory name
; PSFILE - file name
;Output: PSRC - populated return code
;
;check parameters
I $G(PSDIR)="" S PSRC="0^no directory name" Q
I $G(PSFILE)="" S PSRC="0^no file name" Q
S PSZFRC=$ZF(-1,"delete "_PSDIR_PSFILE_";*")
I PSZFRC=-1 S PSRC="0^VMS OS command execution failed" Q
Q
;
SAVEKEYS(LOCDIR) ; Saves Key to local directory
;Input: LOCDIR - Local directory where the keys should be saved to
N WLN,XPV
I $$GET1^DIQ(57.23,1,39,"I")="SSH2" D
. ;Saving the Private SSH Key
. D OPEN^%ZISH("VSSHKEY",LOCDIR,"VSSHKEY","W")
. D USE^%ZISUTL("VSSHKEY")
. F WLN=1:1 Q:'$D(^PS(57.23,1,"PRVKEY",WLN)) D
. . W $$DECRYP^XUSRB1(^PS(57.23,1,"PRVKEY",WLN,0)),!
. D CLOSE^%ZISH("VSSHKEY")
;
I $$OS^%ZOSV()["VMS" D Q
. ;Saving the Public SSH Key (Assuming SSH2 format) - VMS Only
. D OPEN^%ZISH("VSSHKEY",LOCDIR,"VSSHKEY.PUB","W")
. D USE^%ZISUTL("VSSHKEY")
. F WLN=1:1 Q:'$D(^PS(57.23,1,"PUBKEY",WLN)) D
. . W $$DECRYP^XUSRB1(^PS(57.23,1,"PUBKEY",WLN,0)),!
. D CLOSE^%ZISH("VSSHKEY")
;
I $$OS^%ZOSV()["UNIX" D Q
. ;If Key format is SSH2, convert VSSHKEY to OpenSSH format; Otherwise write directly from VistA
. I $$GET1^DIQ(57.23,1,39,"I")="SSH2" D
. . S XPV="S PV=$ZF(-1,""ssh-keygen -i -f "_LOCDIR_"VSSHKEY > "_LOCDIR_"uxsshkey"")"
. . X XPV
. E D
. . ;Saving the Private SSH Key (OpenSSH Format)
. . D OPEN^%ZISH("uxsshkey",LOCDIR,"uxsshkey","W")
. . D USE^%ZISUTL("uxsshkey")
. . F WLN=1:1 Q:'$D(^PS(57.23,1,"PRVKEY",WLN)) D
. . . W $$DECRYP^XUSRB1(^PS(57.23,1,"PRVKEY",WLN,0)),!
. . D CLOSE^%ZISH("uxsshkey")
. S XPV="S PV=$ZF(-1,""chmod 600 "_LOCDIR_"uxsshkey"")"
. X XPV
Q
DIREXIST(DIR) ; Returns whether the Linux Directory for sFTP already exists
;Input: DIR - Linux Directory name to be checked
;*573 Added condition check for IRIS
N DIREXIST,PSNVER
S PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
I DIR="" Q 0
I $$OS^%ZOSV()'="UNIX" Q 0
I PSNVER'["CACHE",PSNVER'["IRIS" Q 0
I $E(DIR,$L(DIR))="/" S $E(DIR,$L(DIR))=""
X "S DIREXIST=$ZSEARCH(DIR)"
Q $S(DIREXIST="":0,1:1)
;
MAKEDIR(DIR) ; Create a new directory
;Input: DIR - Linux Directory name to be created
;*573 Added condition check for IRIS
N MKDIR,PSNVER
S PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
I $$OS^%ZOSV()'="UNIX" Q
I PSNVER'["CACHE",PSNVER'["IRIS" Q
I $$DIREXIST(DIR) Q
X "S MKDIR=$ZF(-1,""mkdir ""_DIR)"
I 'MKDIR X "S MKDIR=$ZF(-1,""chmod 777 ""_DIR)"
Q
;
DELFILES(LOCDIR,LOGFILE,PSCOMFIL,PSDATFIL) ; Delete Files
;Input: LOCDIR - Local Directory
;
N FILE2DEL,PSOOS
I $G(LOCDIR)="" Q
S PSOOS=$$OS^%ZOSV()
S:$G(LOGFILE)'="" FILE2DEL(LOGFILE)=""
S:$G(PSCOMFIL)'="" FILE2DEL(PSCOMFIL)=""
S:$G(PSDATFIL)'="" FILE2DEL(PSDATFIL)=""
I PSOOS["VMS" S FILE2DEL("VSSHID.")="",FILE2DEL("VSSHKEY.")="",FILE2DEL("VSSHKEY.PUB")=""
I PSOOS["UNIX" S FILE2DEL("PSNSIZE.DAT")="",FILE2DEL("VSSHKEY")="",FILE2DEL("uxsshkey")=""
I PSOOS["NT" S FILE2DEL("VSSHKEY")="",FILE2DEL("VSSHKEY.PUB")=""
D DEL^%ZISH(LOCDIR,"FILE2DEL")
Q
;
XVMSDIR(VMSDIR) ; Converts a VMS directory
; Input: VMSDIR - OpenVMS directory name (e.g., "USER$:[SFTP.PPSN]")
; Output: $$XVMSDIR - Converted VMS directory (e.g., "/USER$/PPSN/")
;
Q "/"_$TR(VMSDIR,".[]:","///")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNFTP2 14089 printed Sep 23, 2025@20:00:06 Page 2
PSNFTP2 ;HP/ART - PPS-N National Drug File Updates File Transfer ;09/25/2015
+1 ;;4.0;NATIONAL DRUG FILE;**513,573**; 30 Oct 98;Build 6
+2 ;Supported ICRs/IAs
+3 ;External reference to ^%ZISH supported by DBIA 2320
+4 ;External reference to ^%ZISUTL supported by DBIA 2119
+5 ;External reference to ^XLFSTR supported by DBIA 10104
+6 ;Reference to ^PS(59.7 supported by DBIA 2613
+7 ;
VMSFTP(PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCOMFIL,PSLOGFIL,PSDATFIL,PSERRMSG) ; VMS FTP
+1 ; ALL PARARMETERS ARE REQUIRED EXCEPT PASSWORD
+2 ;Inputs: PSRC - return code, by reference
+3 ; PSADDR - remote server address
+4 ; PSNUSER - target system user name
+5 ; PSWRKDIR - local work directory name
+6 ; PSLOCDIR - local directory name
+7 ; PSREMDIR - remote directory name
+8 ; PSREMFIL - remote file name
+9 ; PSCOMFIL - ftp .com file name
+10 ; PSLOGFIL - ftp log file name
+11 ; PSDATFIL - sftp commands file name
+12 ;Output: PSRC - populated return code
+13 ;
+14 ;check parameters
+15 IF $GET(PSADDR)=""
SET PSRC="0^no target server address"
QUIT
+16 IF $GET(PSNUSER)=""
SET PSRC="0^no user name"
QUIT
+17 IF $GET(PSWRKDIR)=""
SET PSRC="0^no local work directory name"
QUIT
+18 IF $GET(PSLOCDIR)=""
SET PSRC="0^no local directory name"
QUIT
+19 IF $GET(PSREMDIR)=""
SET PSRC="0^no remote directory name"
QUIT
+20 IF $GET(PSREMFIL)=""
SET PSRC="0^no remote file name"
QUIT
+21 IF $GET(PSCOMFIL)=""
SET PSRC="0^no ftp .com file name"
QUIT
+22 IF $GET(PSLOGFIL)=""
SET PSRC="0^no ftp log file name"
QUIT
+23 IF $GET(PSDATFIL)=""
SET PSRC="0^no sftp commands file name"
QUIT
+24 ;
+25 ;create .dat file with sftp commands
+26 DO CREATDAT^PSNFTP(.PSRC,PSDATFIL,PSWRKDIR,PSREMDIR,PSREMFIL)
if '+PSRC
QUIT
+27 ;
+28 ;create .com file
+29 NEW POP,FTPPORT
SET FTPPORT=""
+30 DO OPEN^%ZISH("FILE1",PSWRKDIR,PSCOMFIL,"W")
+31 IF POP
SET PSRC="0^failed to open ftp .com file"
QUIT
+32 DO USE^%ZISUTL("FILE1")
+33 WRITE "$ set verify=(PROCEDURE,IMAGE)",!
+34 WRITE "$ set default ",PSLOCDIR,!
+35 WRITE "$ sftp"_$SELECT(FTPPORT:" -oPort="_FTPPORT,1:"")_" -oIdentityFile="""_$$XVMSDIR(PSWRKDIR)_"VSSHID."" -""B"" "_PSWRKDIR_PSDATFIL_" -oUser="_PSNUSER_" "_PSADDR,!
+36 WRITE "$ exit",!
+37 DO CLOSE^%ZISH("FILE1")
+38 ;
+39 DO OPEN^%ZISH("VSSHID",PSWRKDIR,"VSSHID.","W")
+40 IF POP
SET PSRC="-1^FTP Script file <"_PSWRKDIR_"VSSHID.> could not be created."
QUIT
+41 DO USE^%ZISUTL("VSSHID")
+42 WRITE "IDKEY "_$$XVMSDIR(PSWRKDIR)_"VSSHKEY"
+43 DO CLOSE^%ZISH("VSSHID")
+44 ;
EXECUTE ;Execute .COM file, create logfile
+1 NEW PSZFRC
+2 SET PSZFRC=$ZF(-1,"@"_PSWRKDIR_PSCOMFIL_"/OUTPUT="_PSWRKDIR_PSLOGFIL)
+3 ; Error check
+4 IF PSZFRC=-1
SET PSRC="0^VMS OS command execution failed"
QUIT
+5 ;
+6 ; Read Logfile into working global
+7 KILL ^TMP("PSNFTPLOG",$JOB)
+8 NEW PSXLOG
+9 SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNFTPLOG",$JOB,1)),3)
+10 ; Check for error during ftp
+11 NEW PSPNG,PSPNG1,PSSTOP
+12 SET PSPNG=""
SET PSPNG1=0
SET PSSTOP=0
+13 FOR
SET PSPNG=$ORDER(^TMP("PSNFTPLOG",$JOB,PSPNG))
if PSPNG=""!PSSTOP
QUIT
Begin DoDot:1
+14 SET PSPNG1=$GET(^TMP("PSNFTPLOG",$JOB,PSPNG))
+15 IF PSPNG1["%TCPIP-E-SSH_FC_ERR_NO_S, file doesn't exist"
SET PSRC="0^Remote file was not found"
SET PSSTOP=1
QUIT
+16 IF PSPNG1["%TCPIP-F-SSH_FATAL"
SET PSRC="0^non-specific fatal error"
SET PSSTOP=1
QUIT
+17 IF PSPNG1["530 Login incorrect"
SET PSRC="0^server login failure"
SET PSSTOP=1
QUIT
+18 IF PSPNG1["550-Failed to open"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+19 IF PSPNG1["550 file not found"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+20 IF PSPNG1["no such file"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+21 IF PSPNG1["No such file"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+22 IF PSPNG1["error processing output file"
SET PSRC="-1^remote file already downloaded"
SET PSSTOP=1
QUIT
+23 IF PSPNG1["insufficient privilege"
SET PSRC="-1^remote file already downloaded"
SET PSSTOP=1
QUIT
+24 IF PSPNG1["%SET-F-SEARCHFAIL"
SET PSRC="0^local file not found - change file permission"
SET PSSTOP=1
QUIT
+25 IF PSPNG1["%TCPIP-E-SSH_FC_ERR_DEST"
SET PSRC="0^destination is not directory or does not exist"
SET PSSTOP=1
QUIT
+26 IF PSPNG1["%TCPIP-E-SSH_FC_ERROR"
SET PSRC="0^destination is not directory or does not exist"
SET PSSTOP=1
QUIT
End DoDot:1
+27 IF PSSTOP=0
SET PSERRMSG(1)="1^File Transfer is complete"
+28 DO DELFILES($GET(PSWRKDIR),$GET(PSLOGFIL),$GET(PSCOMFIL),$GET(PSDATFIL))
+29 QUIT
+30 ;
LINUXFTP(PSRC,PSADDR,PSNUSER,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSSHFILE,PSLOGFIL,PSDATFIL) ; Linux FTP
+1 ; ALL PARARMETERS ARE REQUIRED EXCEPT PASSWORD
+2 ;Inputs: PSRC - return code, by reference
+3 ; PSADDR - remote server address
+4 ; PSNUSER - target system user name
+5 ; PSWRKDIR - local work directory name
+6 ; PSLOCDIR - local directory name
+7 ; PSREMDIR - remote directory name
+8 ; PSREMFIL - remote file name
+9 ; PSSHFILE - ftp .sh file name
+10 ; PSLOGFIL - ftp log file name
+11 ; PSDATFIL - sftp commands file name
+12 ;Output: PSRC - populated return code
+13 ;
+14 ;check parameters
+15 IF $GET(PSADDR)=""
SET PSRC="0^no target server address"
QUIT
+16 IF $GET(PSNUSER)=""
SET PSRC="0^no user name"
QUIT
+17 IF $GET(PSWRKDIR)=""
SET PSRC="0^no local work directory name"
QUIT
+18 IF $GET(PSLOCDIR)=""
SET PSRC="0^no local directory name"
QUIT
+19 IF $GET(PSREMDIR)=""
SET PSRC="0^no remote directory name"
QUIT
+20 IF $GET(PSREMFIL)=""
SET PSRC="0^no remote file name"
QUIT
+21 IF $GET(PSSHFILE)=""
SET PSRC="0^no ftp .sh file name"
QUIT
+22 IF $GET(PSLOGFIL)=""
SET PSRC="0^no ftp log file name"
QUIT
+23 IF $GET(PSDATFIL)=""
SET PSRC="0^no sftp commands file name"
QUIT
+24 ;
+25 ;create .dat file with sftp commands
+26 DO CREATDAT^PSNFTP(.PSRC,PSDATFIL,PSWRKDIR,PSREMDIR,PSREMFIL)
if '+PSRC
QUIT
+27 ;create .sh file
+28 NEW POP,DEBUG1
SET DEBUG1=1
+29 DO OPEN^%ZISH("FILE1",PSWRKDIR,PSSHFILE,"W")
+30 IF POP
SET PSRC="0^failed to open ftp .sh file"
QUIT
+31 DO USE^%ZISUTL("FILE1")
+32 ; Linux .sh commands
+33 WRITE "#!/bin/bash",!!
+34 WRITE "cd ",PSWRKDIR,!
+35 WRITE "sftp"_" -oIdentityFile="""""_PSWRKDIR_"uxsshkey"""" -b "_PSWRKDIR_PSDATFIL_" -oStrictHostKeyChecking=no -oUser="_PSNUSER_" "_PSADDR_" >> "_PSWRKDIR_PSLOGFIL
+36 WRITE !,"exit",!
+37 DO CLOSE^%ZISH("FILE1")
+38 ;
+39 ; Execute .sh file, create logfile
+40 NEW PSZFRC
+41 SET PSZFRC=$ZF(-1,PSWRKDIR_PSSHFILE_" >"_PSWRKDIR_PSLOGFIL)
+42 ; Error check
+43 IF PSZFRC=-1
SET PSRC="0^Linux OS command execution failed"
QUIT
+44 ;
+45 ; Read Logfile into working global
+46 KILL ^TMP("PSNFTPLOG",$JOB)
+47 NEW PSXLOG
+48 SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNFTPLOG",$JOB,1)),3)
+49 ; Check for error during ftp
+50 NEW PSPNG,PSPNG1,PSSTOP,UXEXIT
+51 SET PSPNG=""
SET (PSPNG1,PSSTOP,UXEXIT)=0
+52 FOR
SET PSPNG=$ORDER(^TMP("PSNFTPLOG",$JOB,PSPNG))
if PSPNG=""!PSSTOP
QUIT
Begin DoDot:1
+53 SET PSPNG1=$GET(^TMP("PSNFTPLOG",$JOB,PSPNG))
+54 IF $$UP^XLFSTR(PSPNG1)["SFTP> EXIT"
SET UXEXIT=1
QUIT
+55 IF PSPNG1["425 Not logged in"
SET PSRC="0^Login incorrect"
SET PSSTOP=1
QUIT
+56 IF PSPNG1["530 Login incorrect"
SET PSRC="0^Login incorrect"
SET PSSTOP=1
QUIT
+57 IF PSPNG1["550-Failed to open"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+58 IF PSPNG1["550 file not found"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+59 IF PSPNG1["no such file"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+60 IF PSPNG1["No such file"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
End DoDot:1
+61 IF UXEXIT=0
SET PSRC="-1^Remote file was not found"
SET PSSTOP=1
QUIT
+62 IF PSSTOP=0
IF UXEXIT
SET PSERRMSG(1)="1^File Transfer is complete"
+63 DO DELFILES($GET(PSWRKDIR),$GET(PSLOGFIL),$GET(PSCOMFIL),$GET(PSDATFIL))
+64 QUIT
+65 ;
WINFTP(PSRC,PSADDR,PSUID,PSWRKDIR,PSLOCDIR,PSREMDIR,PSREMFIL,PSCMDFIL,PSLOGFIL) ; Windows FTP
+1 ; ALL PARARMETERS ARE REQUIRED EXCEPT PASSWORD
+2 ;Inputs: PSRC - return code, by reference
+3 ; PSADDR - remote server address
+4 ; PSUID - target system user name
+5 ; PSWRKDIR - local work directory name
+6 ; PSLOCDIR - local directory name
+7 ; PSREMDIR - remote directory name
+8 ; PSREMFIL - remote file name
+9 ; PSCMDFIL - ftp commands file name
+10 ; PSLOGFIL - ftp log file name
+11 ;Output: PSRC - populated return code
+12 ;
+13 ;check parameters
+14 IF $GET(PSADDR)=""
SET PSRC="0^no target server address"
QUIT
+15 IF $GET(PSUID)=""
SET PSRC="0^no user name"
QUIT
+16 IF $GET(PSWRKDIR)=""
SET PSRC="0^no local work directory name"
QUIT
+17 IF $GET(PSLOCDIR)=""
SET PSRC="0^no local directory name"
QUIT
+18 IF $GET(PSREMDIR)=""
SET PSRC="0^no remote directory name"
QUIT
+19 IF $GET(PSREMFIL)=""
SET PSRC="0^no remote file name"
QUIT
+20 IF $GET(PSCMDFIL)=""
SET PSRC="0^no ftp commands file name"
QUIT
+21 IF $GET(PSLOGFIL)=""
SET PSRC="0^no ftp log file name"
QUIT
+22 ;create ftp commands file
+23 NEW POP
+24 DO OPEN^%ZISH("FILE1",PSWRKDIR,PSCMDFIL,"W")
+25 IF POP
SET PSRC="0^failed to open ftp commands file"
QUIT
+26 DO USE^%ZISUTL("FILE1")
+27 WRITE "open ",PSADDR,!
+28 WRITE PSUID,!
+29 WRITE "lcd ",PSLOCDIR,!
+30 WRITE "cd ",PSREMDIR,!
+31 WRITE "ascii",!
+32 WRITE "get ",PSREMFIL,!
+33 WRITE "quit",!
+34 DO CLOSE^%ZISH("FILE1")
+35 ; Execute ftp file, create logfile
+36 NEW PSZFRC
+37 SET PSZFRC=$ZF(-1,"sftp -s:"_PSWRKDIR_PSCMDFIL_" >"_PSWRKDIR_PSLOGFIL)
+38 ; Error check
+39 IF PSZFRC=-1
SET PSRC="0^Windows OS command execution failed"
QUIT
+40 ; Read Logfile into working global
+41 KILL ^TMP("PSNFTPLOG",$JOB)
+42 NEW PSXLOG
+43 SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,PSLOGFIL,$NAME(^TMP("PSNFTPLOG",$JOB,1)),3)
+44 ; Check for error during ftp
+45 NEW PSPNG,PSPNG1,PSSTOP
+46 SET PSPNG=""
+47 SET PSPNG1=0
+48 SET PSSTOP=0
+49 FOR
SET PSPNG=$ORDER(^TMP("PSNFTPLOG",$JOB,PSPNG))
if PSPNG=""!PSSTOP
QUIT
Begin DoDot:1
+50 SET PSPNG1=$GET(^TMP("PSNFTPLOG",$JOB,PSPNG))
+51 IF PSPNG1["530 Login incorrect"
SET PSRC="0^Login incorrect"
SET PSSTOP=1
QUIT
+52 IF PSPNG1["425 Not logged in"
SET PSRC="0^Login incorrect"
SET PSSTOP=1
QUIT
+53 IF PSPNG1["550-Failed to open"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+54 IF PSPNG1["550 file not found"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+55 IF PSPNG1["no such file"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
+56 IF PSPNG1["No such file"
SET PSRC="-1^remote file not found"
SET PSSTOP=1
QUIT
End DoDot:1
+57 QUIT
+58 ;
FILSIZE(PSDIR,PSFILE,PSSIZE,PSNFLAG1) ;get the file size after retrieval
+1 NEW PSDIR,PSFSIZL,PSFSIZL2,DIE,DA,D0,DR,PSXLOG,PSSEQ,PSSEQD,PSIEN,ERROR,PSOS,X
+2 SET PSOS=$$GETOS^PSNFTP
+3 if '$DATA(PSDIR)
SET PSDIR=$$GETD^PSNFTP()
+4 SET PSFSIZL="PSFSIZE.LOG"
+5 SET X=$ZF(-1,"DIR/SIZE=UNITS=BYTES "_PSDIR_PSFILE,PSDIR_PSFSIZL)
+6 SET PSXLOG=""
SET PSXLOG=$$FTG^%ZISH(PSDIR,PSFSIZL,$NAME(^TMP("PSNFSIZELOG",$JOB,1)),3)
+7 SET (PSSEQ,PSSEQD,PSIEN,DIE,DR,DA)=""
+8 FOR
SET PSSEQ=$ORDER(^TMP("PSNFSIZELOG",$JOB,PSSEQ))
if PSSEQ=""
QUIT
Begin DoDot:1
+9 SET PSSEQD=$GET(^TMP("PSNFSIZELOG",$JOB,PSSEQ))
+10 IF PSSEQD["Total of"
SET PSSIZE=$PIECE(PSSEQD,",",2)
End DoDot:1
+11 SET PSFSIZL2="PSFSIZE2.LOG"
+12 SET X=$ZF(-1,"DIR/SIZE "_PSDIR_PSFILE,PSDIR_PSFSIZL2)
+13 SET PSXLOG=""
SET PSXLOG=$$FTG^%ZISH(PSDIR,PSFSIZL2,$NAME(^TMP("PSNFSIZELOG2",$JOB,1)),3)
+14 SET (PSSEQ,PSSEQD,PSIEN,DIE,DR,DA)=""
+15 FOR
SET PSSEQ=$ORDER(^TMP("PSNFSIZELOG2",$JOB,PSSEQ))
if PSSEQ=""
QUIT
Begin DoDot:1
+16 SET PSSEQD=$GET(^TMP("PSNFSIZELOG2",$JOB,PSSEQ))
+17 IF PSSEQD["Total of"
SET PSSIZE=PSSIZE_" or"_$PIECE($PIECE(PSSEQD,",",2),".")
End DoDot:1
+18 if $GET(PSNFLAG1)
GOTO FILSIZQ
+19 SET PSIEN=""
SET PSIEN=$ORDER(^PS(57.23,1,4,"B",PSFILE_";1",PSIEN))
+20 if PSIEN=""
GOTO FILSIZQ
+21 IF '$GET(PSNFLAG1)
SET DIE="^PS(57.23,1,4,"
SET DA=PSIEN
SET DR="3///"_PSSIZE
DO ^DIE
FILSIZQ ;
+1 IF '$GET(PSOS)
SET PSOS=$$GETOS^PSNFTP
+2 IF PSOS["VMS"
Begin DoDot:1
+3 DO VMSDEL(1,PSDIR,PSFSIZL)
+4 DO VMSDEL(1,PSDIR,PSFSIZL2)
End DoDot:1
+5 KILL ^TMP("PSNFSIZELOG",$JOB)
+6 QUIT
+7 ;
VMSDEL(PSRC,PSDIR,PSFILE) ;Delete Local Host File
+1 ;Inputs: PSRC - return code, by reference
+2 ; PSDIR - directory name
+3 ; PSFILE - file name
+4 ;Output: PSRC - populated return code
+5 ;
+6 ;check parameters
+7 IF $GET(PSDIR)=""
SET PSRC="0^no directory name"
QUIT
+8 IF $GET(PSFILE)=""
SET PSRC="0^no file name"
QUIT
+9 SET PSZFRC=$ZF(-1,"delete "_PSDIR_PSFILE_";*")
+10 IF PSZFRC=-1
SET PSRC="0^VMS OS command execution failed"
QUIT
+11 QUIT
+12 ;
SAVEKEYS(LOCDIR) ; Saves Key to local directory
+1 ;Input: LOCDIR - Local directory where the keys should be saved to
+2 NEW WLN,XPV
+3 IF $$GET1^DIQ(57.23,1,39,"I")="SSH2"
Begin DoDot:1
+4 ;Saving the Private SSH Key
+5 DO OPEN^%ZISH("VSSHKEY",LOCDIR,"VSSHKEY","W")
+6 DO USE^%ZISUTL("VSSHKEY")
+7 FOR WLN=1:1
if '$DATA(^PS(57.23,1,"PRVKEY",WLN))
QUIT
Begin DoDot:2
+8 WRITE $$DECRYP^XUSRB1(^PS(57.23,1,"PRVKEY",WLN,0)),!
End DoDot:2
+9 DO CLOSE^%ZISH("VSSHKEY")
End DoDot:1
+10 ;
+11 IF $$OS^%ZOSV()["VMS"
Begin DoDot:1
+12 ;Saving the Public SSH Key (Assuming SSH2 format) - VMS Only
+13 DO OPEN^%ZISH("VSSHKEY",LOCDIR,"VSSHKEY.PUB","W")
+14 DO USE^%ZISUTL("VSSHKEY")
+15 FOR WLN=1:1
if '$DATA(^PS(57.23,1,"PUBKEY",WLN))
QUIT
Begin DoDot:2
+16 WRITE $$DECRYP^XUSRB1(^PS(57.23,1,"PUBKEY",WLN,0)),!
End DoDot:2
+17 DO CLOSE^%ZISH("VSSHKEY")
End DoDot:1
QUIT
+18 ;
+19 IF $$OS^%ZOSV()["UNIX"
Begin DoDot:1
+20 ;If Key format is SSH2, convert VSSHKEY to OpenSSH format; Otherwise write directly from VistA
+21 IF $$GET1^DIQ(57.23,1,39,"I")="SSH2"
Begin DoDot:2
+22 SET XPV="S PV=$ZF(-1,""ssh-keygen -i -f "_LOCDIR_"VSSHKEY > "_LOCDIR_"uxsshkey"")"
+23 XECUTE XPV
End DoDot:2
+24 IF '$TEST
Begin DoDot:2
+25 ;Saving the Private SSH Key (OpenSSH Format)
+26 DO OPEN^%ZISH("uxsshkey",LOCDIR,"uxsshkey","W")
+27 DO USE^%ZISUTL("uxsshkey")
+28 FOR WLN=1:1
if '$DATA(^PS(57.23,1,"PRVKEY",WLN))
QUIT
Begin DoDot:3
+29 WRITE $$DECRYP^XUSRB1(^PS(57.23,1,"PRVKEY",WLN,0)),!
End DoDot:3
+30 DO CLOSE^%ZISH("uxsshkey")
End DoDot:2
+31 SET XPV="S PV=$ZF(-1,""chmod 600 "_LOCDIR_"uxsshkey"")"
+32 XECUTE XPV
End DoDot:1
QUIT
+33 QUIT
DIREXIST(DIR) ; Returns whether the Linux Directory for sFTP already exists
+1 ;Input: DIR - Linux Directory name to be checked
+2 ;*573 Added condition check for IRIS
+3 NEW DIREXIST,PSNVER
+4 SET PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
+5 IF DIR=""
QUIT 0
+6 IF $$OS^%ZOSV()'="UNIX"
QUIT 0
+7 IF PSNVER'["CACHE"
IF PSNVER'["IRIS"
QUIT 0
+8 IF $EXTRACT(DIR,$LENGTH(DIR))="/"
SET $EXTRACT(DIR,$LENGTH(DIR))=""
+9 XECUTE "S DIREXIST=$ZSEARCH(DIR)"
+10 QUIT $SELECT(DIREXIST="":0,1:1)
+11 ;
MAKEDIR(DIR) ; Create a new directory
+1 ;Input: DIR - Linux Directory name to be created
+2 ;*573 Added condition check for IRIS
+3 NEW MKDIR,PSNVER
+4 SET PSNVER=$$UP^XLFSTR($$VERSION^%ZOSV(1))
+5 IF $$OS^%ZOSV()'="UNIX"
QUIT
+6 IF PSNVER'["CACHE"
IF PSNVER'["IRIS"
QUIT
+7 IF $$DIREXIST(DIR)
QUIT
+8 XECUTE "S MKDIR=$ZF(-1,""mkdir ""_DIR)"
+9 IF 'MKDIR
XECUTE "S MKDIR=$ZF(-1,""chmod 777 ""_DIR)"
+10 QUIT
+11 ;
DELFILES(LOCDIR,LOGFILE,PSCOMFIL,PSDATFIL) ; Delete Files
+1 ;Input: LOCDIR - Local Directory
+2 ;
+3 NEW FILE2DEL,PSOOS
+4 IF $GET(LOCDIR)=""
QUIT
+5 SET PSOOS=$$OS^%ZOSV()
+6 if $GET(LOGFILE)'=""
SET FILE2DEL(LOGFILE)=""
+7 if $GET(PSCOMFIL)'=""
SET FILE2DEL(PSCOMFIL)=""
+8 if $GET(PSDATFIL)'=""
SET FILE2DEL(PSDATFIL)=""
+9 IF PSOOS["VMS"
SET FILE2DEL("VSSHID.")=""
SET FILE2DEL("VSSHKEY.")=""
SET FILE2DEL("VSSHKEY.PUB")=""
+10 IF PSOOS["UNIX"
SET FILE2DEL("PSNSIZE.DAT")=""
SET FILE2DEL("VSSHKEY")=""
SET FILE2DEL("uxsshkey")=""
+11 IF PSOOS["NT"
SET FILE2DEL("VSSHKEY")=""
SET FILE2DEL("VSSHKEY.PUB")=""
+12 DO DEL^%ZISH(LOCDIR,"FILE2DEL")
+13 QUIT
+14 ;
XVMSDIR(VMSDIR) ; Converts a VMS directory
+1 ; Input: VMSDIR - OpenVMS directory name (e.g., "USER$:[SFTP.PPSN]")
+2 ; Output: $$XVMSDIR - Converted VMS directory (e.g., "/USER$/PPSN/")
+3 ;
+4 QUIT "/"_$TRANSLATE(VMSDIR,".[]:","///")
+5 ;
