- 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 Apr 23, 2025@18:04:10 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 ;
