RCXVFTP ;DAOU/ALA-FTP AR Data Extract Batch Files ;08-SEP-03
;;4.5;Accounts Receivable;**201,256,292,395,447**;Mar 20, 1995;Build 4
;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This code will ftp a batch file
;
EN(FILE,DIREC) ;
Q ; PRCA*4.5*447 Extract has been sunsetted
;
; Input Parameter
; FILE = Filename
; DIREC = Directory
S RCXVPTH=$S($G(DIREC)'="":DIREC,1:RCXVDIR)
;
SYS ; Get system type
S RCXVSYS=$$VERSION^%ZOSV(1)
I RCXVSYS["DSM" S RCXVSYS="VMS",RCXVSYT="DSM"
I RCXVSYS["MSM" D
. I RCXVSYS["NT"!(RCXVSYS["PC") S RCXVSYS="MSM",RCXVSYT="MSM" Q
. E S RCXVSYS="UNIX",RCXVSYT="MSM"
I RCXVSYS["Cache" D
. I RCXVSYS["VMS" S RCXVSYS="VMS",RCXVSYT="CACHE" Q
. ; For Full Linux OS
. I RCXVSYS["UNIX" S RCXVSYS="UNIX",RCXVSYT="CACHE" Q
. S RCXVSYS="CACHE",RCXVSYT="CACHE"
;
I RCXVSYS="VMS" S RCXVNME=FILE_";1"
I RCXVSYS'="VMS" S RCXVNME=FILE
;
ARC ; Directly FTP to the Boston Allocation Resource Center
; PRCA*4.5*395 updates receiving server location
; get the SFTP gateway server information
I $$GET1^DIQ(342,"1,",20.06,"I")="P" D
. D GETWP^XPAR(.RCXVIP,"PKG","PRCA SFTP","SFTP SERVER")
. D GETWP^XPAR(.RCXVUSR,"PKG","PRCA SFTP","SFTP USERNAME")
. Q
;
;. S RCXVIP="MORPHEUS.ARC.DOMAIN.EXT"
;. S RCXVUSR="mccf"
;. S RCXVPAS="1qaz2wsx"
S RCXVPAS="1qaz2wsx" ;PRCA*4.5*395 old FTP password for previous receiving site !!!may move to CTXT^RCXVFTC where it is used if we do away with 'P statement!!!
;
I $$GET1^DIQ(342,"1,",20.06,"I")'="P" D
. S RCXVIP="MORPHEUS.ARC.DOMAIN.EXT"
. S RCXVUSR="cbotest1"
. S RCXVPAS="1qaz2wsx"
;
I RCXVSYS="VMS" D ^RCXVFTV
I RCXVSYS'="VMS" D ^RCXVFTC
;
S RCXVARRY(RCXVTXT)="",RCXVARRY(RCXVBAT)="",RCXVARRY(RCXVNME)=""
S Y=$$DEL^%ZISH(RCXVPTH,$NA(RCXVARRY))
K RCXVARRY,%ZISHF,%ZISHO,%ZISUB,DIREC,FILE,I,RCXCT,RCXI,RCXOKAY,RCXVBAT
K RCXVFTP,RCXVHNDL,RCXVIP,RCXVNME,RCXVOUT,RCXVPAS,RCXVPTH,RCXVSCR,XMY
K RCXVSYS,RCXVSYT,RCXVTXT,RCXVUSR,RCXVVMS,CNT,QER,QFL,RCXMGRP,XMSUB
K VALMSG,RCXVROOT
Q
;
FCK ; Check that file is ready to read
S QFL=0,CNT=0,QER=0
FQT I QFL Q
D OPEN^%ZISH(RCXVHNDL,RCXVPTH,RCXVSCR,"R")
I POP D G FQT
. HANG 5
. S CNT=CNT+1
. I CNT>10 S QFL=1,QER=1 D CLOSE^%ZISH(RCXVHNDL)
S QFL=1 D CLOSE^%ZISH(RCXVHNDL)
G FQT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVFTP 2354 printed Sep 23, 2025@19:25:49 Page 2
RCXVFTP ;DAOU/ALA-FTP AR Data Extract Batch Files ;08-SEP-03
+1 ;;4.5;Accounts Receivable;**201,256,292,395,447**;Mar 20, 1995;Build 4
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This code will ftp a batch file
+6 ;
EN(FILE,DIREC) ;
+1 ; PRCA*4.5*447 Extract has been sunsetted
QUIT
+2 ;
+3 ; Input Parameter
+4 ; FILE = Filename
+5 ; DIREC = Directory
+6 SET RCXVPTH=$SELECT($GET(DIREC)'="":DIREC,1:RCXVDIR)
+7 ;
SYS ; Get system type
+1 SET RCXVSYS=$$VERSION^%ZOSV(1)
+2 IF RCXVSYS["DSM"
SET RCXVSYS="VMS"
SET RCXVSYT="DSM"
+3 IF RCXVSYS["MSM"
Begin DoDot:1
+4 IF RCXVSYS["NT"!(RCXVSYS["PC")
SET RCXVSYS="MSM"
SET RCXVSYT="MSM"
QUIT
+5 IF '$TEST
SET RCXVSYS="UNIX"
SET RCXVSYT="MSM"
End DoDot:1
+6 IF RCXVSYS["Cache"
Begin DoDot:1
+7 IF RCXVSYS["VMS"
SET RCXVSYS="VMS"
SET RCXVSYT="CACHE"
QUIT
+8 ; For Full Linux OS
+9 IF RCXVSYS["UNIX"
SET RCXVSYS="UNIX"
SET RCXVSYT="CACHE"
QUIT
+10 SET RCXVSYS="CACHE"
SET RCXVSYT="CACHE"
End DoDot:1
+11 ;
+12 IF RCXVSYS="VMS"
SET RCXVNME=FILE_";1"
+13 IF RCXVSYS'="VMS"
SET RCXVNME=FILE
+14 ;
ARC ; Directly FTP to the Boston Allocation Resource Center
+1 ; PRCA*4.5*395 updates receiving server location
+2 ; get the SFTP gateway server information
+3 IF $$GET1^DIQ(342,"1,",20.06,"I")="P"
Begin DoDot:1
+4 DO GETWP^XPAR(.RCXVIP,"PKG","PRCA SFTP","SFTP SERVER")
+5 DO GETWP^XPAR(.RCXVUSR,"PKG","PRCA SFTP","SFTP USERNAME")
+6 QUIT
End DoDot:1
+7 ;
+8 ;. S RCXVIP="MORPHEUS.ARC.DOMAIN.EXT"
+9 ;. S RCXVUSR="mccf"
+10 ;. S RCXVPAS="1qaz2wsx"
+11 ;PRCA*4.5*395 old FTP password for previous receiving site !!!may move to CTXT^RCXVFTC where it is used if we do away with 'P statement!!!
SET RCXVPAS="1qaz2wsx"
+12 ;
+13 IF $$GET1^DIQ(342,"1,",20.06,"I")'="P"
Begin DoDot:1
+14 SET RCXVIP="MORPHEUS.ARC.DOMAIN.EXT"
+15 SET RCXVUSR="cbotest1"
+16 SET RCXVPAS="1qaz2wsx"
End DoDot:1
+17 ;
+18 IF RCXVSYS="VMS"
DO ^RCXVFTV
+19 IF RCXVSYS'="VMS"
DO ^RCXVFTC
+20 ;
+21 SET RCXVARRY(RCXVTXT)=""
SET RCXVARRY(RCXVBAT)=""
SET RCXVARRY(RCXVNME)=""
+22 SET Y=$$DEL^%ZISH(RCXVPTH,$NAME(RCXVARRY))
+23 KILL RCXVARRY,%ZISHF,%ZISHO,%ZISUB,DIREC,FILE,I,RCXCT,RCXI,RCXOKAY,RCXVBAT
+24 KILL RCXVFTP,RCXVHNDL,RCXVIP,RCXVNME,RCXVOUT,RCXVPAS,RCXVPTH,RCXVSCR,XMY
+25 KILL RCXVSYS,RCXVSYT,RCXVTXT,RCXVUSR,RCXVVMS,CNT,QER,QFL,RCXMGRP,XMSUB
+26 KILL VALMSG,RCXVROOT
+27 QUIT
+28 ;
FCK ; Check that file is ready to read
+1 SET QFL=0
SET CNT=0
SET QER=0
FQT IF QFL
QUIT
+1 DO OPEN^%ZISH(RCXVHNDL,RCXVPTH,RCXVSCR,"R")
+2 IF POP
Begin DoDot:1
+3 HANG 5
+4 SET CNT=CNT+1
+5 IF CNT>10
SET QFL=1
SET QER=1
DO CLOSE^%ZISH(RCXVHNDL)
End DoDot:1
GOTO FQT
+6 SET QFL=1
DO CLOSE^%ZISH(RCXVHNDL)
+7 GOTO FQT
+8 ;
