RCXVFTR ;DAOU/ALA-Retrieve FTP messages ;17-DEC-2003
;;4.5;Accounts Receivable;**201,395**;Mar 20, 1995;Build 9
;Per VA Directive 6402, this routine should not be modified.
;**Program Description**
; This program will read all the ftp messages to
; see if they were successful or not
;
EN ; Find all temporary files
K ^TMP("RCXVIN",$J)
S CNT=0,QFL=0
S RCXVDIR=$P($G(^RC(342,1,20)),U,1)
;
; Go through and read each one
S RCVL=""
F S RCVL=$O(^TMP("RCXVMSG",$J,RCVL)) Q:RCVL="" D
. K ^TMP("RCXVIN",$J)
. ;
. S RCXVBTN=$P(RCVL,"_",3),RCXVBTN=$P(RCXVBTN,".",1)
. S Y=$$FTG^%ZISH(RCXVDIR,RCVL,$NA(^TMP("RCXVIN",$J,1,0)),3)
. ;
. I $O(^TMP("RCXVIN",$J,0))="" S ^TMP("RCXVIN",$J,1,0)="No FTP command file found for batch #"_RCXVBTN
. ;
. S RCXOKAY=0,RCXI=0
. F S RCXI=$O(^TMP("RCXVIN",$J,RCXI)) Q:'RCXI D
.. I $E($G(^TMP("RCXVIN",$J,RCXI,0)),1,4)="SFTP" S ^TMP("RCXVIN",$J,1,0)="SFTP failed for batch #"_RCXVBTN
.. I $E($G(^TMP("RCXVIN",$J,RCXI,0)),1,3)="226" S RCXOKAY=1
. ;
. ; If the transfer does not say complete, send a mail message
. I 'RCXOKAY D
.. S RCXMGRP=$$GET1^DIQ(342,"1,",20.02,"E")
.. I RCXMGRP="" S RCXMGRP="IRM"
.. S RCXMGRP="G."_RCXMGRP
.. S XMDUZ="CBO DATA EXTRACT",XMY(RCXMGRP)=""
.. S XMSUB="CBO/ARC TRANSMISSION ATTEMPT"
.. S XMTEXT="^TMP(""RCXVIN"",$J,"
.. D ^XMD
.. K XMDUN,XMDUZ,XMZ,XMY
. ;
. I RCXOKAY D
.. S RCXVUP(348.4,RCXVBTN_",",.08)=$$NOW^XLFDT()
.. I $P(^RCXV(RCXVBTN,0),"^",3)'="C" S RCXVUP(348.4,RCXVBTN_",",.03)="T"
.. D FILE^DIE("I","RCXVUP","RCXVERR")
;
S Y=$$DEL^%ZISH(RCXVDIR,$NA(^TMP("RCXVMSG",$J)))
;
EXIT K C,CNT,RCXOKAY,RCXVUP,RCXVERR,RCXVLST,Y,RCXMGRP,RCXI,RCVL,QFL,RCXVARY,I
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVFTR 1721 printed Dec 13, 2024@01:49:41 Page 2
RCXVFTR ;DAOU/ALA-Retrieve FTP messages ;17-DEC-2003
+1 ;;4.5;Accounts Receivable;**201,395**;Mar 20, 1995;Build 9
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;**Program Description**
+4 ; This program will read all the ftp messages to
+5 ; see if they were successful or not
+6 ;
EN ; Find all temporary files
+1 KILL ^TMP("RCXVIN",$JOB)
+2 SET CNT=0
SET QFL=0
+3 SET RCXVDIR=$PIECE($GET(^RC(342,1,20)),U,1)
+4 ;
+5 ; Go through and read each one
+6 SET RCVL=""
+7 FOR
SET RCVL=$ORDER(^TMP("RCXVMSG",$JOB,RCVL))
if RCVL=""
QUIT
Begin DoDot:1
+8 KILL ^TMP("RCXVIN",$JOB)
+9 ;
+10 SET RCXVBTN=$PIECE(RCVL,"_",3)
SET RCXVBTN=$PIECE(RCXVBTN,".",1)
+11 SET Y=$$FTG^%ZISH(RCXVDIR,RCVL,$NAME(^TMP("RCXVIN",$JOB,1,0)),3)
+12 ;
+13 IF $ORDER(^TMP("RCXVIN",$JOB,0))=""
SET ^TMP("RCXVIN",$JOB,1,0)="No FTP command file found for batch #"_RCXVBTN
+14 ;
+15 SET RCXOKAY=0
SET RCXI=0
+16 FOR
SET RCXI=$ORDER(^TMP("RCXVIN",$JOB,RCXI))
if 'RCXI
QUIT
Begin DoDot:2
+17 IF $EXTRACT($GET(^TMP("RCXVIN",$JOB,RCXI,0)),1,4)="SFTP"
SET ^TMP("RCXVIN",$JOB,1,0)="SFTP failed for batch #"_RCXVBTN
+18 IF $EXTRACT($GET(^TMP("RCXVIN",$JOB,RCXI,0)),1,3)="226"
SET RCXOKAY=1
End DoDot:2
+19 ;
+20 ; If the transfer does not say complete, send a mail message
+21 IF 'RCXOKAY
Begin DoDot:2
+22 SET RCXMGRP=$$GET1^DIQ(342,"1,",20.02,"E")
+23 IF RCXMGRP=""
SET RCXMGRP="IRM"
+24 SET RCXMGRP="G."_RCXMGRP
+25 SET XMDUZ="CBO DATA EXTRACT"
SET XMY(RCXMGRP)=""
+26 SET XMSUB="CBO/ARC TRANSMISSION ATTEMPT"
+27 SET XMTEXT="^TMP(""RCXVIN"",$J,"
+28 DO ^XMD
+29 KILL XMDUN,XMDUZ,XMZ,XMY
End DoDot:2
+30 ;
+31 IF RCXOKAY
Begin DoDot:2
+32 SET RCXVUP(348.4,RCXVBTN_",",.08)=$$NOW^XLFDT()
+33 IF $PIECE(^RCXV(RCXVBTN,0),"^",3)'="C"
SET RCXVUP(348.4,RCXVBTN_",",.03)="T"
+34 DO FILE^DIE("I","RCXVUP","RCXVERR")
End DoDot:2
End DoDot:1
+35 ;
+36 SET Y=$$DEL^%ZISH(RCXVDIR,$NAME(^TMP("RCXVMSG",$JOB)))
+37 ;
EXIT KILL C,CNT,RCXOKAY,RCXVUP,RCXVERR,RCXVLST,Y,RCXMGRP,RCXI,RCVL,QFL,RCXVARY,I
+1 QUIT
+2 ;
