AWCMFTP ;VISN 7/THM-FTP FILES TO SERVER from VISTA ; Feb 27, 2004
;;7.3;TOOLKIT;**84,86,103**;Jan 09, 2004;Build 4
;
W *7,!,"Enter at line EN^AWCMFTP.",!
Q
EN ; variables killed in calling program
S VMSC="" ;INIT THE VAR
; AWCHFIL1= whole VMS path
S AWCHFILE="AWCMOVEHTM.COM" ;COM file name
I AWCX="NT" S AWCHFILE=AWCFILE
S AWCDTAX=$G(^AWC(177100.12,1,0))
S AWCDIR=$P(AWCDTAX,U,5) ;Parameter file
S:AWCDIR="" AWCDIR="SYS$SYSDEVICE:[DSMMGR]" ;DEFAULT
S AWCSITE=$$SITE^VASITE,AWCSITE=$P(AWCSITE,U,2) ;site Name
S AWCSITEN=+$$SITE^VASITE ;3 dig number
S AWCDIRL=$$LOW^XLFSTR(AWCDIR),AWCHFILL=$$LOW^XLFSTR(AWCHFILE)
S AWCWBFLD=$P(AWCDTAX,U,15),AWCWBFLD=$$LOW^XLFSTR(AWCWBFLD) ;web page folder
; Note: file deletion is not a problem for NT/Cache since it overwrites the files
S AWCMVMSL=+$P(AWCDTAX,U,16) ;VMS logging
S AWCMVMSD=+$P(AWCDTAX,U,18) ;VMS delete
S AWCDIRCH=+$P(AWCDTAX,U,19) ;use change dir command?
S AWCWBFLD=$P(AWCWBFLD,"/",2)
D @AWCX
Q
;
NT ; NT script
S AWCC=1
K ^TMP("AWCMFTP",$J)
S ^TMP("AWCMFTP",$J,AWCC,0)="open "_AWCMSRV,AWCC=AWCC+1 ;server ip address
S ^TMP("AWCMFTP",$J,AWCC,0)=AWCMUSR,AWCC=AWCC+1 ; ftp user
S ^TMP("AWCMFTP",$J,AWCC,0)=AWCMPW,AWCC=AWCC+1 ;ftp password
S ^TMP("AWCMFTP",$J,AWCC,0)="ascii",AWCC=AWCC+1
I $G(AWCDIRCH)=1 S ^TMP("AWCMFTP",$J,AWCC,0)="cd "_AWCWBFLD,AWCC=AWCC+1 ;****
S ^TMP("AWCMFTP",$J,AWCC,0)="put "_AWCDIRL_"\"_AWCHFILE,AWCC=AWCC+1 ;****
S ^TMP("AWCMFTP",$J,AWCC,0)="bye"
; write it to the NT directory
S Y=$$GTF^%ZISH($NA(^TMP("AWCMFTP",$J,1,0)),3,AWCDIRL,"ftpawc.txt")
; send command to NT to execute this batch file
S CMD="S AWCVAR=$ZF(-1,""ftp -s:""_AWCDIRL_""\ftpawc.txt"")"
X CMD G EXIT
;
VMSC ; VMS FOR CACHE MODS TO DOUBLE CHECK FOR OS
S VMSC=1
;
VMS ; VMS com file script
; Captive process so we give full privs
S AWC=1
K ^TMP("AWCMFTP",$J)
S ^TMP("AWCMFTP",$J,AWC,0)="$ set proc/priv = all"
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ set noon"
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ assign sys$command sys$input "
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ set verify"
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ a=""''f$user()'"""
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ set def "_AWCDIR
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_AWCHFILE
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ ftp "_AWCMSRV
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)=AWCMUSR
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)=AWCMPW
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="ascii"
I $G(AWCDIRCH)=1 S ^TMP("AWCMFTP",$J,AWC,0)="cd "_AWCWBFLD ;****
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="put "_AWCHFIL1
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="bye"
S AWC=AWC+1,^TMP("AWCMFTP",$J,AWC,0)="$ exit"
; send to VMS
S Y=$$GTF^%ZISH($NA(^TMP("AWCMFTP",$J,1,0)),3,AWCDIR,AWCHFILE)
G:VMSC VMSC1
;
; USE $&ZLIB EXTERNAL CALLS FOR DSM/VMS
S CMD="S %SUBMIT=$&ZLIB.%SUBMIT"_"("""_AWCDIR_AWCHFILE_""""_","_"""/NOPRINT"_$S(AWCMVMSL=1:"/LOG="_AWCDIR_$P(AWCHFILE,".",1)_".LOG"""_")",1:"/NOLOG"""_")")
X CMD
G EXIT
VMSC1 ;
; VMS Cache - use $ZF(-1 calls for OS commands
S CMD="S AWCVAR=$ZF(-1,AWCVAR)"
S AWCVAR="SUBMIT "_AWCDIR_AWCHFILE_"/NOPRINT"_$S(AWCMVMSL=1:"/LOG="_AWCDIR_$P(AWCHFILE,".",1)_".LOG",1:"/NOLOG")
X CMD
;
EXIT K CMD,^TMP("AWCMFTP"),^TMP("AWCMFTPD"),AWCMVMSL,AWCMVMSD,AWCDTAX,AWC,AWCDIRCH
Q
;
PURDEL ; purging/deletion script - whether this occurs is controlled in file 177100.12
; this part creates a com file to purge or delete files we have created and then it deletes itself
;
S AWCDTAX=$G(^AWC(177100.12,1,0))
S AWCMVMSL=+$P(AWCDTAX,U,16) ;VMS logging
S AWCMVMSD=+$P(AWCDTAX,U,18) ;VMS delete
S AWCHFILE="AWCPURGE.COM"
; captive process again so we give full privs
K ^TMP("AWCMFTPD",$J)
S AWC=1,^TMP("AWCMFTPD",$J,AWC,0)="$ wait 00:05"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set proc/priv = all"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set noon"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ assign sys$command sys$input "
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set verify"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ a=""''f$user()'"""
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set def "_AWCDIR
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_"AWCMOVEHTM.LOG;*"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_"AWCMOVEHTM.COM;*"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCHFIL1_";*"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_"AWCPURGE.COM;*"
; purge or keep log files - 0 deletes all, 1 leaves one copy
I AWCMVMSL=1 S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ purge/keep=1 "_AWCDIR_"AWCMOVEHTM.LOG"
I AWCMVMSL=0 S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ delete "_AWCDIR_"AWCMOVEHTM.LOG;*"
; purge or delete all COM versions - 0 deletes all, 1 leaves one copy
I AWCMVMSD=1 S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ delete "_AWCDIR_"AWCMOVEHTM.COM;*"
I AWCMVMSD=0 S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ purge/keep=1 "_AWCDIR_"AWCMOVEHTM.COM;*"
; delete the web pages - automatic, not user controlled
; patch 103 change for RDPC environment jls/oak-oifo 10/2006
;S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ delete "_$P(AWCHFIL1,"_",1)_"*.*;*"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ delete "_AWCDIR_$P(AWCDTAX,U,6)_"*.*;*"
S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ exit"
; send to VMS
S Y=$$GTF^%ZISH($NA(^TMP("AWCMFTPD",$J,1,0)),3,AWCDIR,AWCHFILE)
I AWCX="VMS" S CMD="S %SUBMIT=$&ZLIB.%SUBMIT"_"("""_AWCDIR_AWCHFILE_""""_","_"""/DELETE /NOPRINT /NOLOG"""_")"
I AWCX="VMSC" S CMD="S AWCVAR=$ZF(-1,AWCVAR)"
I AWCX="VMSC" S AWCVAR="SUBMIT "_AWCDIR_AWCHFILE_"/DELETE /NOPRINT /NOLOG"
X CMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAWCMFTP 5941 printed Apr 09, 2024@21:42:08 Page 2
AWCMFTP ;VISN 7/THM-FTP FILES TO SERVER from VISTA ; Feb 27, 2004
+1 ;;7.3;TOOLKIT;**84,86,103**;Jan 09, 2004;Build 4
+2 ;
+3 WRITE *7,!,"Enter at line EN^AWCMFTP.",!
+4 QUIT
EN ; variables killed in calling program
+1 ;INIT THE VAR
SET VMSC=""
+2 ; AWCHFIL1= whole VMS path
+3 ;COM file name
SET AWCHFILE="AWCMOVEHTM.COM"
+4 IF AWCX="NT"
SET AWCHFILE=AWCFILE
+5 SET AWCDTAX=$GET(^AWC(177100.12,1,0))
+6 ;Parameter file
SET AWCDIR=$PIECE(AWCDTAX,U,5)
+7 ;DEFAULT
if AWCDIR=""
SET AWCDIR="SYS$SYSDEVICE:[DSMMGR]"
+8 ;site Name
SET AWCSITE=$$SITE^VASITE
SET AWCSITE=$PIECE(AWCSITE,U,2)
+9 ;3 dig number
SET AWCSITEN=+$$SITE^VASITE
+10 SET AWCDIRL=$$LOW^XLFSTR(AWCDIR)
SET AWCHFILL=$$LOW^XLFSTR(AWCHFILE)
+11 ;web page folder
SET AWCWBFLD=$PIECE(AWCDTAX,U,15)
SET AWCWBFLD=$$LOW^XLFSTR(AWCWBFLD)
+12 ; Note: file deletion is not a problem for NT/Cache since it overwrites the files
+13 ;VMS logging
SET AWCMVMSL=+$PIECE(AWCDTAX,U,16)
+14 ;VMS delete
SET AWCMVMSD=+$PIECE(AWCDTAX,U,18)
+15 ;use change dir command?
SET AWCDIRCH=+$PIECE(AWCDTAX,U,19)
+16 SET AWCWBFLD=$PIECE(AWCWBFLD,"/",2)
+17 DO @AWCX
+18 QUIT
+19 ;
NT ; NT script
+1 SET AWCC=1
+2 KILL ^TMP("AWCMFTP",$JOB)
+3 ;server ip address
SET ^TMP("AWCMFTP",$JOB,AWCC,0)="open "_AWCMSRV
SET AWCC=AWCC+1
+4 ; ftp user
SET ^TMP("AWCMFTP",$JOB,AWCC,0)=AWCMUSR
SET AWCC=AWCC+1
+5 ;ftp password
SET ^TMP("AWCMFTP",$JOB,AWCC,0)=AWCMPW
SET AWCC=AWCC+1
+6 SET ^TMP("AWCMFTP",$JOB,AWCC,0)="ascii"
SET AWCC=AWCC+1
+7 ;****
IF $GET(AWCDIRCH)=1
SET ^TMP("AWCMFTP",$JOB,AWCC,0)="cd "_AWCWBFLD
SET AWCC=AWCC+1
+8 ;****
SET ^TMP("AWCMFTP",$JOB,AWCC,0)="put "_AWCDIRL_"\"_AWCHFILE
SET AWCC=AWCC+1
+9 SET ^TMP("AWCMFTP",$JOB,AWCC,0)="bye"
+10 ; write it to the NT directory
+11 SET Y=$$GTF^%ZISH($NAME(^TMP("AWCMFTP",$JOB,1,0)),3,AWCDIRL,"ftpawc.txt")
+12 ; send command to NT to execute this batch file
+13 SET CMD="S AWCVAR=$ZF(-1,""ftp -s:""_AWCDIRL_""\ftpawc.txt"")"
+14 XECUTE CMD
GOTO EXIT
+15 ;
VMSC ; VMS FOR CACHE MODS TO DOUBLE CHECK FOR OS
+1 SET VMSC=1
+2 ;
VMS ; VMS com file script
+1 ; Captive process so we give full privs
+2 SET AWC=1
+3 KILL ^TMP("AWCMFTP",$JOB)
+4 SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ set proc/priv = all"
+5 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ set noon"
+6 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ assign sys$command sys$input "
+7 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ set verify"
+8 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ a=""''f$user()'"""
+9 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ set def "_AWCDIR
+10 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_AWCHFILE
+11 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ ftp "_AWCMSRV
+12 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)=AWCMUSR
+13 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)=AWCMPW
+14 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="ascii"
+15 ;****
IF $GET(AWCDIRCH)=1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="cd "_AWCWBFLD
+16 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="put "_AWCHFIL1
+17 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="bye"
+18 SET AWC=AWC+1
SET ^TMP("AWCMFTP",$JOB,AWC,0)="$ exit"
+19 ; send to VMS
+20 SET Y=$$GTF^%ZISH($NAME(^TMP("AWCMFTP",$JOB,1,0)),3,AWCDIR,AWCHFILE)
+21 if VMSC
GOTO VMSC1
+22 ;
+23 ; USE $&ZLIB EXTERNAL CALLS FOR DSM/VMS
+24 SET CMD="S %SUBMIT=$&ZLIB.%SUBMIT"_"("""_AWCDIR_AWCHFILE_""""_","_"""/NOPRINT"_$SELECT(AWCMVMSL=1:"/LOG="_AWCDIR_$PIECE(AWCHFILE,".",1)_".LOG"""_")",1:"/NOLOG"""_")")
+25 XECUTE CMD
+26 GOTO EXIT
VMSC1 ;
+1 ; VMS Cache - use $ZF(-1 calls for OS commands
+2 SET CMD="S AWCVAR=$ZF(-1,AWCVAR)"
+3 SET AWCVAR="SUBMIT "_AWCDIR_AWCHFILE_"/NOPRINT"_$SELECT(AWCMVMSL=1:"/LOG="_AWCDIR_$PIECE(AWCHFILE,".",1)_".LOG",1:"/NOLOG")
+4 XECUTE CMD
+5 ;
EXIT KILL CMD,^TMP("AWCMFTP"),^TMP("AWCMFTPD"),AWCMVMSL,AWCMVMSD,AWCDTAX,AWC,AWCDIRCH
+1 QUIT
+2 ;
PURDEL ; purging/deletion script - whether this occurs is controlled in file 177100.12
+1 ; this part creates a com file to purge or delete files we have created and then it deletes itself
+2 ;
+3 SET AWCDTAX=$GET(^AWC(177100.12,1,0))
+4 ;VMS logging
SET AWCMVMSL=+$PIECE(AWCDTAX,U,16)
+5 ;VMS delete
SET AWCMVMSD=+$PIECE(AWCDTAX,U,18)
+6 SET AWCHFILE="AWCPURGE.COM"
+7 ; captive process again so we give full privs
+8 KILL ^TMP("AWCMFTPD",$JOB)
+9 SET AWC=1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ wait 00:05"
+10 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set proc/priv = all"
+11 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set noon"
+12 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ assign sys$command sys$input "
+13 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set verify"
+14 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ a=""''f$user()'"""
+15 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set def "_AWCDIR
+16 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_"AWCMOVEHTM.LOG;*"
+17 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_"AWCMOVEHTM.COM;*"
+18 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCHFIL1_";*"
+19 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ set prot=(w:rwed,g:rwed,o:rwed,s:rwed) "_AWCDIR_"AWCPURGE.COM;*"
+20 ; purge or keep log files - 0 deletes all, 1 leaves one copy
+21 IF AWCMVMSL=1
SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ purge/keep=1 "_AWCDIR_"AWCMOVEHTM.LOG"
+22 IF AWCMVMSL=0
SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ delete "_AWCDIR_"AWCMOVEHTM.LOG;*"
+23 ; purge or delete all COM versions - 0 deletes all, 1 leaves one copy
+24 IF AWCMVMSD=1
SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ delete "_AWCDIR_"AWCMOVEHTM.COM;*"
+25 IF AWCMVMSD=0
SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ purge/keep=1 "_AWCDIR_"AWCMOVEHTM.COM;*"
+26 ; delete the web pages - automatic, not user controlled
+27 ; patch 103 change for RDPC environment jls/oak-oifo 10/2006
+28 ;S AWC=AWC+1,^TMP("AWCMFTPD",$J,AWC,0)="$ delete "_$P(AWCHFIL1,"_",1)_"*.*;*"
+29 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ delete "_AWCDIR_$PIECE(AWCDTAX,U,6)_"*.*;*"
+30 SET AWC=AWC+1
SET ^TMP("AWCMFTPD",$JOB,AWC,0)="$ exit"
+31 ; send to VMS
+32 SET Y=$$GTF^%ZISH($NAME(^TMP("AWCMFTPD",$JOB,1,0)),3,AWCDIR,AWCHFILE)
+33 IF AWCX="VMS"
SET CMD="S %SUBMIT=$&ZLIB.%SUBMIT"_"("""_AWCDIR_AWCHFILE_""""_","_"""/DELETE /NOPRINT /NOLOG"""_")"
+34 IF AWCX="VMSC"
SET CMD="S AWCVAR=$ZF(-1,AWCVAR)"
+35 IF AWCX="VMSC"
SET AWCVAR="SUBMIT "_AWCDIR_AWCHFILE_"/DELETE /NOPRINT /NOLOG"
+36 XECUTE CMD
+37 QUIT
