RCXVFTC ;DAOU/ALA-FTP for Cache NT ; 10/10/12 11:54am
;;4.5;Accounts Receivable;**201,292,395**;Mar 20, 1995;Build 9
;Per VA Directive 6402, this routine should not be modified.
;SAC EXEMPTION 20220504-01: Allows the use of the $ZF(-100) function.
;
OUT ; Outgoing
D SAVEKEYS ;added in PRCA*4.5*395 to get SSH KEY for SFTP
D CTXT
;
S Y=$$GTF^%ZISH($NA(^TMP($J,"RCXVFTP",1,0)),3,RCXVPTH,RCXVBAT)
K ^TMP($J,"RCXVFTP")
I 'Y S VALMSG="Not able to create the .COM file" Q
;
BAT ; Create the .COM file
;S RCXVOUT="S X=$ZF(-1,""ftp -n -s:""_RCXVPTH_RCXVBAT_"">""_RCXVPTH_RCXVSCR)"
;updated to IF statement in PRCA*4.5*395 to handle non-UNIX systems
I RCXVSYS'["UNIX" D
.S RCXVOUT="S X=$ZF(-1,""ftp -n -s:""_RCXVPTH_RCXVBAT_"">""_RCXVPTH_RCXVSCR)"
.X RCXVOUT
.Q
;
; For Full Linux OS, PRCA*4.5*395 CHANGES FTP TO SFTP
I RCXVSYS["UNIX" D
.S RCXVOUT=$ZF(-100,"","sftp","-o StrictHostKeyChecking no","-i",RCXVPTH_"sftpsshkey_"_$J,"-b",RCXVPTH_RCXVBAT,RCXVUSR_"@"_RCXVIP)
.I RCXVOUT=0 D
..D OPEN^%ZISH(RCXVSCR,RCXVDIR,RCXVSCR,"W")
..D USE^%ZISUTL(RCXVSCR)
..W "226_SFTP return status ="_RCXVOUT,! ;226 is a successful transmission indicator used in RCXVFTR transfer status routine
..D CLOSE^%ZISH(RCXVSCR)
..Q
.I RCXVOUT'=0 D
..D OPEN^%ZISH(RCXVSCR,RCXVDIR,RCXVSCR,"W")
..D USE^%ZISUTL(RCXVSCR)
..W "SFTP failed, status ="_RCXVOUT,!
..D CLOSE^%ZISH(RCXVSCR)
..Q
.Q
;. S RCXVOUT="S X=$ZF(-1,""ftp -n -v <""_RCXVPTH_RCXVBAT_"">""_RCXVPTH_RCXVSCR)"
;
;X RCXVOUT
D DELK
Q
;
CTXT ;
S RCXVFTP="RCXVCBO"
S RCXVSCR=RCXVSCR_".LIS",^TMP("RCXVMSG",$J,RCXVSCR)=""
S RCXVBAT=RCXVFTP_$S($G(RCXVSYS)="VMS":".COM",1:".BAT")
S RCXVTXT=RCXVFTP_".TXT"
;
; Kill off the .COM and .TXT files
S RCXVARRY(RCXVTXT)="",RCXVARRY(RCXVBAT)=""
S Y=$$DEL^%ZISH(RCXVPTH,$NA(RCXVARRY))
K RCXVARRY
;
; S ^TMP($J,"RCXVFTP",1,0)="open "_RCXVIP
; S ^TMP($J,"RCXVFTP",2,0)="user "_RCXVUSR_" "_RCXVPAS
;
; A root directory must have a slash for CACHE NT
; but a folder cannot have a slash
I RCXVPTH?1A1":\" S RCXVROOT=$E(RCXVPTH,1,$L(RCXVPTH))
I RCXVPTH'?1A1":\" S RCXVROOT=$S($E(RCXVPTH,$L(RCXVPTH),$L(RCXVPTH))="\":$E(RCXVPTH,1,$L(RCXVPTH)-1),1:RCXVPTH)
;
;PRCA*4.5*395 used for FTP .BAT file build
I RCXVSYS'["UNIX" D
.S ^TMP($J,"RCXVFTP",1,0)="open "_RCXVIP
.S ^TMP($J,"RCXVFTP",2,0)="user "_RCXVUSR_" "_RCXVPAS
.S ^TMP($J,"RCXVFTP",3,0)="lcd "_RCXVROOT
.S ^TMP($J,"RCXVFTP",4,0)="put "_RCXVNME
.S ^TMP($J,"RCXVFTP",5,0)="quit"
.Q
;
;PRCA*4.5*395 used for SFTP .BAT file build
I RCXVSYS["UNIX" D
.S ^TMP($J,"RCXVFTP",1,0)="lcd "_RCXVROOT
.S ^TMP($J,"RCXVFTP",2,0)="put "_RCXVNME
.S ^TMP($J,"RCXVFTP",3,0)="quit"
.Q
Q
;
SAVEKEYS ;PRCA*4.5*395 retrieves the private key from the database and builds it in the appropriate host file.
N WLINE,RCXVPV,RCXVPRKY,RCXVPRM
D GETWP^XPAR(.RCXVPRKY,"PKG","PRCA SFTP","SFTP SSH PRIVATE KEY") ; get private key
;
I $$OS^%ZOSV()["UNIX" D Q
.; Building the Private SSH Key host file
.D OPEN^%ZISH("sftpsshkey",RCXVDIR,"sftpsshkey_"_$J,"W")
.D USE^%ZISUTL("sftpsshkey")
.F WLINE=1:1 Q:'$D(RCXVPRKY(WLINE,0)) W $$DECRYP^XUSRB1(RCXVPRKY(WLINE,0)),!
.D CLOSE^%ZISH("sftpsshkey")
.S RCXVPRM=$ZF(-100,"","chmod","600",RCXVPTH_"sftpsshkey_"_$J)
.Q
;
Q
;
DELK ; PRCA*4.5*395 Delete the ssh private key file - sftpsshkey_$J
N RCXVARRY,Y
S RCXVARRY("sftpsshkey_"_$J)=""
S Y=$$DEL^%ZISH(RCXVDIR,$NA(RCXVARRY))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVFTC 3492 printed Apr 09, 2024@20:45:18 Page 2
RCXVFTC ;DAOU/ALA-FTP for Cache NT ; 10/10/12 11:54am
+1 ;;4.5;Accounts Receivable;**201,292,395**;Mar 20, 1995;Build 9
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;SAC EXEMPTION 20220504-01: Allows the use of the $ZF(-100) function.
+4 ;
OUT ; Outgoing
+1 ;added in PRCA*4.5*395 to get SSH KEY for SFTP
DO SAVEKEYS
+2 DO CTXT
+3 ;
+4 SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"RCXVFTP",1,0)),3,RCXVPTH,RCXVBAT)
+5 KILL ^TMP($JOB,"RCXVFTP")
+6 IF 'Y
SET VALMSG="Not able to create the .COM file"
QUIT
+7 ;
BAT ; Create the .COM file
+1 ;S RCXVOUT="S X=$ZF(-1,""ftp -n -s:""_RCXVPTH_RCXVBAT_"">""_RCXVPTH_RCXVSCR)"
+2 ;updated to IF statement in PRCA*4.5*395 to handle non-UNIX systems
+3 IF RCXVSYS'["UNIX"
Begin DoDot:1
+4 SET RCXVOUT="S X=$ZF(-1,""ftp -n -s:""_RCXVPTH_RCXVBAT_"">""_RCXVPTH_RCXVSCR)"
+5 XECUTE RCXVOUT
+6 QUIT
End DoDot:1
+7 ;
+8 ; For Full Linux OS, PRCA*4.5*395 CHANGES FTP TO SFTP
+9 IF RCXVSYS["UNIX"
Begin DoDot:1
+10 SET RCXVOUT=$ZF(-100,"","sftp","-o StrictHostKeyChecking no","-i",RCXVPTH_"sftpsshkey_"_$JOB,"-b",RCXVPTH_RCXVBAT,RCXVUSR_"@"_RCXVIP)
+11 IF RCXVOUT=0
Begin DoDot:2
+12 DO OPEN^%ZISH(RCXVSCR,RCXVDIR,RCXVSCR,"W")
+13 DO USE^%ZISUTL(RCXVSCR)
+14 ;226 is a successful transmission indicator used in RCXVFTR transfer status routine
WRITE "226_SFTP return status ="_RCXVOUT,!
+15 DO CLOSE^%ZISH(RCXVSCR)
+16 QUIT
End DoDot:2
+17 IF RCXVOUT'=0
Begin DoDot:2
+18 DO OPEN^%ZISH(RCXVSCR,RCXVDIR,RCXVSCR,"W")
+19 DO USE^%ZISUTL(RCXVSCR)
+20 WRITE "SFTP failed, status ="_RCXVOUT,!
+21 DO CLOSE^%ZISH(RCXVSCR)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 ;. S RCXVOUT="S X=$ZF(-1,""ftp -n -v <""_RCXVPTH_RCXVBAT_"">""_RCXVPTH_RCXVSCR)"
+25 ;
+26 ;X RCXVOUT
+27 DO DELK
+28 QUIT
+29 ;
CTXT ;
+1 SET RCXVFTP="RCXVCBO"
+2 SET RCXVSCR=RCXVSCR_".LIS"
SET ^TMP("RCXVMSG",$JOB,RCXVSCR)=""
+3 SET RCXVBAT=RCXVFTP_$SELECT($GET(RCXVSYS)="VMS":".COM",1:".BAT")
+4 SET RCXVTXT=RCXVFTP_".TXT"
+5 ;
+6 ; Kill off the .COM and .TXT files
+7 SET RCXVARRY(RCXVTXT)=""
SET RCXVARRY(RCXVBAT)=""
+8 SET Y=$$DEL^%ZISH(RCXVPTH,$NAME(RCXVARRY))
+9 KILL RCXVARRY
+10 ;
+11 ; S ^TMP($J,"RCXVFTP",1,0)="open "_RCXVIP
+12 ; S ^TMP($J,"RCXVFTP",2,0)="user "_RCXVUSR_" "_RCXVPAS
+13 ;
+14 ; A root directory must have a slash for CACHE NT
+15 ; but a folder cannot have a slash
+16 IF RCXVPTH?1A1":\"
SET RCXVROOT=$EXTRACT(RCXVPTH,1,$LENGTH(RCXVPTH))
+17 IF RCXVPTH'?1A1":\"
SET RCXVROOT=$SELECT($EXTRACT(RCXVPTH,$LENGTH(RCXVPTH),$LENGTH(RCXVPTH))="\":$EXTRACT(RCXVPTH,1,$LENGTH(RCXVPTH)-1),1:RCXVPTH)
+18 ;
+19 ;PRCA*4.5*395 used for FTP .BAT file build
+20 IF RCXVSYS'["UNIX"
Begin DoDot:1
+21 SET ^TMP($JOB,"RCXVFTP",1,0)="open "_RCXVIP
+22 SET ^TMP($JOB,"RCXVFTP",2,0)="user "_RCXVUSR_" "_RCXVPAS
+23 SET ^TMP($JOB,"RCXVFTP",3,0)="lcd "_RCXVROOT
+24 SET ^TMP($JOB,"RCXVFTP",4,0)="put "_RCXVNME
+25 SET ^TMP($JOB,"RCXVFTP",5,0)="quit"
+26 QUIT
End DoDot:1
+27 ;
+28 ;PRCA*4.5*395 used for SFTP .BAT file build
+29 IF RCXVSYS["UNIX"
Begin DoDot:1
+30 SET ^TMP($JOB,"RCXVFTP",1,0)="lcd "_RCXVROOT
+31 SET ^TMP($JOB,"RCXVFTP",2,0)="put "_RCXVNME
+32 SET ^TMP($JOB,"RCXVFTP",3,0)="quit"
+33 QUIT
End DoDot:1
+34 QUIT
+35 ;
SAVEKEYS ;PRCA*4.5*395 retrieves the private key from the database and builds it in the appropriate host file.
+1 NEW WLINE,RCXVPV,RCXVPRKY,RCXVPRM
+2 ; get private key
DO GETWP^XPAR(.RCXVPRKY,"PKG","PRCA SFTP","SFTP SSH PRIVATE KEY")
+3 ;
+4 IF $$OS^%ZOSV()["UNIX"
Begin DoDot:1
+5 ; Building the Private SSH Key host file
+6 DO OPEN^%ZISH("sftpsshkey",RCXVDIR,"sftpsshkey_"_$JOB,"W")
+7 DO USE^%ZISUTL("sftpsshkey")
+8 FOR WLINE=1:1
if '$DATA(RCXVPRKY(WLINE,0))
QUIT
WRITE $$DECRYP^XUSRB1(RCXVPRKY(WLINE,0)),!
+9 DO CLOSE^%ZISH("sftpsshkey")
+10 SET RCXVPRM=$ZF(-100,"","chmod","600",RCXVPTH_"sftpsshkey_"_$JOB)
+11 QUIT
End DoDot:1
QUIT
+12 ;
+13 QUIT
+14 ;
DELK ; PRCA*4.5*395 Delete the ssh private key file - sftpsshkey_$J
+1 NEW RCXVARRY,Y
+2 SET RCXVARRY("sftpsshkey_"_$JOB)=""
+3 SET Y=$$DEL^%ZISH(RCXVDIR,$NAME(RCXVARRY))
+4 QUIT
+5 ;
