Routine: AWCMFTP

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.",!

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAWCMFTP   5941     printed  Feb 19, 2025@00:05:18                                                                                                                                                                                                     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

AWCMFTP.m