RCXVTSK ;DAOU/ALA-AR Data Extract Nightly Task ;23-JUL-03
;;4.5;Accounts Receivable;**201,227,228,232**;Mar 20, 1995
;
;** Program Description **
; This program is the nightly task program for the
; CBO Data Extract to the Boston Allocation Resource
; Center
;
EN ; Entry point
;
; If a test system has 'turned off' extract, quit
I '$$GET1^DIQ(342,"1,",20.04,"I") Q
;
N $ES,$ET
S $ET="D ER^RCXVTSK"
;
L +^RCXVTSK:60 E Q
;
; Purge completed batches
S IEN="",DIK="^RCXV("
F S IEN=$O(^RCXV("AC","C",IEN)) Q:IEN="" D
. S DA=IEN D ^DIK
;
K ^TMP("RCXVMSG",$J)
;
; Find all deposits/receipts
S RCXVD0="",RCXVRNUM=0,RCXVDT=$$FMADD^XLFDT(DT,-1)
F S RCXVD0=$O(^RCY(344,"ASTAT",0,RCXVD0)) Q:RCXVD0="" D
. S RCXVEDT=$P($G(^RCY(344,RCXVD0,0)),U,12)\1
. I RCXVEDT'=RCXVDT Q
. S RCXVRNUM=RCXVRNUM+1
. D FIL^RCXVDEQ("R")
. D UDR^RCXVDEQ
;
K RCXVD0,RCXVRNUM,RCXVDT,RCXVEDT,RCXVDA,RCVXCTY,RCXVBDT
;
S RCXVBTN="",RCXVU="^",RCXVXDT=DT
;
; If the CCPC calculation is scheduled to run, don't
; run the nightly task
; Patch 228 changes software to allow nightly task on CCPC date
;S X1=$$STD^RCCPCFN,X2=-3 D C^%DTC I X=DT L -^RCXVTSK K X Q
;K X1,X2
;
MONTHLY ;Set up monthly transmission batches
I $E(DT,6,7)="01" D EN^RCXVDC10
NM ; Find all new batches to be transmitted
S RBSQ=0,RBTOT=0
F S RCXVBTN=$O(^RCXV("AC","P",RCXVBTN)) Q:RCXVBTN="" D
. I $G(^RCXV(RCXVBTN,0))="" Q
. S RBSQ=RBSQ+1,RBTOT=RBTOT+1
. I $P(^RCXV(RCXVBTN,0),U,1)'=RCXVBTN S RCXVUP(348.4,RCXVBTN_",",.01)=RCXVBTN
. S RCXVUP(348.4,RCXVBTN_",",.05)=RBSQ
F S RCXVBTN=$O(RCXVUP(348.4,RCXVBTN)) Q:RCXVBTN="" D
. S RCXVUP(348.4,RCXVBTN,.06)=RBTOT
D FILE^DIE("","RCXVUP","RCXVERR")
K RCXVUP
;
S RCXVBTN=""
STRT ; Start the build and transmission of batches
D ^RCXVCHK
F RCSTAT="T","P" F S RCXVBTN=$O(^RCXV("AC",RCSTAT,RCXVBTN)) Q:RCXVBTN="" D
. S RCXVBLN=0,RQFL=0
. S RCXVSITE=$P($$SITE^VASITE(),U,3)
. S RCXVDIR=$P($G(^RC(342,1,20)),U,1)
. S RCXVBDT=$P($G(^RCXV(RCXVBTN,0)),U,2)
. S RCXVBTY=$P($G(^RCXV(RCXVBTN,0)),U,4)
. S RCXVSEQ=$P($G(^RCXV(RCXVBTN,0)),U,5)
. S RCXVSTOT=$P($G(^RCXV(RCXVBTN,0)),U,6)
. S RCXVLDOM=$P($G(^RC(342,1,20)),U,8)
. ;S RCXVLEG=+$P($G(^RC(342,1,20)),U,7)
. ;
. I RCSTAT'="T" D Q:RQFL
.. I $G(RCXVSEQ)="" S RQFL=1 Q
.. I $P(^RCXV(RCXVBTN,0),U,3)="C" S RQFL=1 Q
.. S RCXVUP(348.4,RCXVBTN_",",.03)="T"
.. D FILE^DIE("I","RCXVUP","RCXVERR")
.. K RCXVUP
. ;
. ; If a file has been transmitted but no acknowledgement
. ; has been received after 5 days, resend
. I RCSTAT="T" D Q:RQFL
.. S RCXVTRD=$P($G(^RCXV(RCXVBTN,0)),U,8)\1
.. S RCXVARD=$P($G(^RCXV(RCXVBTN,0)),U,9)\1
.. I $$FMADD^XLFDT(RCXVTRD,5)>DT S RQFL=1
.. ;I RCXVARD=0,RCXVLEG,RCXVTRD'=0 S RQFL=1
. ;
. Q:RQFL
. ; FILENAME=SITE_DATE_BATCH#
. S RCXVFILE="RCXV"_RCXVSITE_RCXVBDT_RCXVBTN_".TXT"
. S RCXVSCR="TMP_RCXV"_RCXVSITE_"_"_RCXVBTN
. D OPEN^%ZISH("RCXVHNDL",RCXVDIR,RCXVFILE,"W")
. U IO
. S RCXVDMN=$P($G(^XTV(8989.3,1,0)),U,1)
. S RCXVDMN=$P($G(^DIC(4.2,RCXVDMN,0)),U,1)
. S RCXVRN=$P($G(^RCXV(RCXVBTN,1,0)),U,4) ; # OF REC FOR BILLS
. I RCXVRN="" S RCXVRN=$P($G(^RCXV(RCXVBTN,2,0)),U,4) ; # REC DEP/REC
. S RCXVRT=$P($G(^RCXV(RCXVBTN,0)),U,4) ; TYPE OF DATA
. W "HDR:"_RCXVSITE_RCXVU_RCXVDMN_RCXVU_RCXVRT_RCXVU_RCXVRN_RCXVU_RCXVBDT_RCXVU_RCXVXDT_RCXVU_RCXVSEQ_RCXVU_RCXVSTOT_RCXVU_RCXVLDOM,!
. F S RCXVBLN=$O(^RCXV(RCXVBTN,1,RCXVBLN)) Q:'RCXVBLN D
.. S DFN=$P(^RCXV(RCXVBTN,1,RCXVBLN,0),U,2)
.. D EN^RCXVDC
. ;
. S RCXVD0=0
. F S RCXVD0=$O(^RCXV(RCXVBTN,2,RCXVD0)) Q:'RCXVD0 D
.. S RCXVEDT=$P($G(^RCY(344,RCXVD0,0)),U,12)\1
.. D D344^RCXVDC8
. ;
. S RCXVD0=0
. F S RCXVD0=$O(^RCXV(RCXVBTN,3,RCXVD0)) Q:'RCXVD0 D
.. S DFN=RCXVD0
.. D D3547^RCXVDC10
. ;
. I $D(^RCXV(RCXVBTN,4)) S RCXVMO=$G(^(4)) D PREREG^RCXVDC10
. ;
. I $D(^RCXV(RCXVBTN,5)) S RCXVMO=$G(^(5)) D BUFFER^RCXVDC10
. ;
. D CLOSE^%ZISH("RCXVHNDL")
. ;
. S $P(^RC(342,1,20),U,9)=$$NOW^XLFDT()
. ;
. ; FTP directly to ARC
. D EN^RCXVFTP(RCXVFILE,RCXVDIR)
;
; Check on FTP transfer messages
D ^RCXVFTR
;
L -^RCXVTSK
EXIT D MSG^RCXVCHK
K IEN,DIK,DA,RCXVBLN,RCXVBTN,RCSTAT,RCXVBDT,RCXVDMN,RCXVXDT,RCXVTRD
K RCXVSITE,RCXVFILE,RCXVRN,RCXVRT,RCXVDIR,RCXVATP,RCXVU,DTACT,RBSQ,RBTOT
K RCFDATE,RCXVCFLG,RCXVDBN,RCXVIDT,RCXVSEQ,RCXVSTOT,RCXVTRD,CCT,DTENT
K RCBLN,RCDBTR,RCDEBT,RCTRAN,RCXVTR,RCBCN,RCXVPFDT,RCXVPTDT,RCXRMB
K RCXVLDOM,RCXVARD,RCXVSUB,RCXVBTY,RCXVLEG,RCXVSCR,Y,X,RCXVMO
K ^TMP("RCXVMSG",$J),^TMP("RCXVA",$J),^TMP("RCXVIN",$J)
Q
;
HIS ; Historical data extract
;
L +^RCXVTSK:60 E HANG 600 G HIS
;
I $G(DT)="" D DT^DICRW
;
I $G(RCXVFFD)="" D
. S RCFDATE=$$FYCY^IBCU8(DT)
. S RCXVFFD=$P(RCFDATE,U,3),RCXVFTD=$P(RCFDATE,U,4)
;
S RCXVDAT=RCXVFFD-.01
F S RCXVDAT=$O(^PRCA(430,"ACTDT",RCXVDAT)) Q:RCXVDAT=""!(RCXVDAT>RCXVFTD) D
. S IEN=""
. F S IEN=$O(^PRCA(430,"ACTDT",RCXVDAT,IEN)) Q:IEN="" D
.. I $P(^PRCA(430,IEN,0),U,8)=16!($P(^PRCA(430,IEN,0),U,8)=40) Q
.. S RCXVBLN=IEN,DFN=$P(^PRCA(430,IEN,0),U,7)
.. D FIL^RCXVDEQ("H")
;
L -^RCXVTSK
;
D EN
K RCXVDAT,RCFDATE,RCXVFFD,RCXVFTD,IEN,DFN,RCXVBLN
;
Q
;
CUR ; Find all current fiscal year bills
;
L +^RCXVTSK:60 E HANG 600 G CUR
;
S TTYP=""
F S TTYP=$O(^PRCA(433,"AT",TTYP)) Q:TTYP="" D
. I '+$P(^PRCA(430.3,TTYP,0),U,6) Q
. S RDATE=RCXVFFD-.01
. F S RDATE=$O(^PRCA(433,"AT",TTYP,RDATE)) Q:RDATE=""!(RDATE\1>RCXVFTD) D
.. S IEN=""
.. F S IEN=$O(^PRCA(433,"AT",TTYP,RDATE,IEN)) Q:IEN="" D
... S RCXVBLN=$P(^PRCA(433,IEN,0),U,2)
... I RCXVBLN="" Q
... S X=$P($G(^PRCA(430,RCXVBLN,0)),U,8)
... I X=16!(X=40) Q
... ; Line below changed for patch 228 to do FY05 extract
... D FIL^RCXVDEQ("E")
;
L -^RCXVTSK
;
D EN
K TTYP,RDATE,RCXVFFD,RCXVFTD,RCXVBLN
Q
;
ACT ; Active data extract
;
L +^RCXVTSK:60 E HANG 600 G ACT
;
NEW STAT,CSTAT,QFL
; Set up the AR Data Queue for all 'Active' and 'Suspended' bills
F STAT=16,40 S IEN="" F S IEN=$O(^PRCA(430,"AC",STAT,IEN)) Q:IEN="" D
. S RCXVBLN=IEN,DFN=$P(^PRCA(430,IEN,0),U,7)
. I $P(^PRCA(430,IEN,0),U,2)="" Q
. S CSTAT=$P(^PRCA(430,IEN,0),U,8)
. I CSTAT'=STAT S QFL=0 D Q:QFL
.. I CSTAT'=16!(CSTAT'=40) S QFL=1
. D FIL^RCXVDEQ("A")
;
L -^RCXVTSK
;
D EN
Q
;
ER ; Unlock and log error
L -^RCXVTSK
D ^%ZTER
D UNWIND^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVTSK 6458 printed Apr 09, 2024@20:48:13 Page 2
RCXVTSK ;DAOU/ALA-AR Data Extract Nightly Task ;23-JUL-03
+1 ;;4.5;Accounts Receivable;**201,227,228,232**;Mar 20, 1995
+2 ;
+3 ;** Program Description **
+4 ; This program is the nightly task program for the
+5 ; CBO Data Extract to the Boston Allocation Resource
+6 ; Center
+7 ;
EN ; Entry point
+1 ;
+2 ; If a test system has 'turned off' extract, quit
+3 IF '$$GET1^DIQ(342,"1,",20.04,"I")
QUIT
+4 ;
+5 NEW $ESTACK,$ETRAP
+6 SET $ETRAP="D ER^RCXVTSK"
+7 ;
+8 LOCK +^RCXVTSK:60
IF '$TEST
QUIT
+9 ;
+10 ; Purge completed batches
+11 SET IEN=""
SET DIK="^RCXV("
+12 FOR
SET IEN=$ORDER(^RCXV("AC","C",IEN))
if IEN=""
QUIT
Begin DoDot:1
+13 SET DA=IEN
DO ^DIK
End DoDot:1
+14 ;
+15 KILL ^TMP("RCXVMSG",$JOB)
+16 ;
+17 ; Find all deposits/receipts
+18 SET RCXVD0=""
SET RCXVRNUM=0
SET RCXVDT=$$FMADD^XLFDT(DT,-1)
+19 FOR
SET RCXVD0=$ORDER(^RCY(344,"ASTAT",0,RCXVD0))
if RCXVD0=""
QUIT
Begin DoDot:1
+20 SET RCXVEDT=$PIECE($GET(^RCY(344,RCXVD0,0)),U,12)\1
+21 IF RCXVEDT'=RCXVDT
QUIT
+22 SET RCXVRNUM=RCXVRNUM+1
+23 DO FIL^RCXVDEQ("R")
+24 DO UDR^RCXVDEQ
End DoDot:1
+25 ;
+26 KILL RCXVD0,RCXVRNUM,RCXVDT,RCXVEDT,RCXVDA,RCVXCTY,RCXVBDT
+27 ;
+28 SET RCXVBTN=""
SET RCXVU="^"
SET RCXVXDT=DT
+29 ;
+30 ; If the CCPC calculation is scheduled to run, don't
+31 ; run the nightly task
+32 ; Patch 228 changes software to allow nightly task on CCPC date
+33 ;S X1=$$STD^RCCPCFN,X2=-3 D C^%DTC I X=DT L -^RCXVTSK K X Q
+34 ;K X1,X2
+35 ;
MONTHLY ;Set up monthly transmission batches
+1 IF $EXTRACT(DT,6,7)="01"
DO EN^RCXVDC10
NM ; Find all new batches to be transmitted
+1 SET RBSQ=0
SET RBTOT=0
+2 FOR
SET RCXVBTN=$ORDER(^RCXV("AC","P",RCXVBTN))
if RCXVBTN=""
QUIT
Begin DoDot:1
+3 IF $GET(^RCXV(RCXVBTN,0))=""
QUIT
+4 SET RBSQ=RBSQ+1
SET RBTOT=RBTOT+1
+5 IF $PIECE(^RCXV(RCXVBTN,0),U,1)'=RCXVBTN
SET RCXVUP(348.4,RCXVBTN_",",.01)=RCXVBTN
+6 SET RCXVUP(348.4,RCXVBTN_",",.05)=RBSQ
End DoDot:1
+7 FOR
SET RCXVBTN=$ORDER(RCXVUP(348.4,RCXVBTN))
if RCXVBTN=""
QUIT
Begin DoDot:1
+8 SET RCXVUP(348.4,RCXVBTN,.06)=RBTOT
End DoDot:1
+9 DO FILE^DIE("","RCXVUP","RCXVERR")
+10 KILL RCXVUP
+11 ;
+12 SET RCXVBTN=""
STRT ; Start the build and transmission of batches
+1 DO ^RCXVCHK
+2 FOR RCSTAT="T","P"
FOR
SET RCXVBTN=$ORDER(^RCXV("AC",RCSTAT,RCXVBTN))
if RCXVBTN=""
QUIT
Begin DoDot:1
+3 SET RCXVBLN=0
SET RQFL=0
+4 SET RCXVSITE=$PIECE($$SITE^VASITE(),U,3)
+5 SET RCXVDIR=$PIECE($GET(^RC(342,1,20)),U,1)
+6 SET RCXVBDT=$PIECE($GET(^RCXV(RCXVBTN,0)),U,2)
+7 SET RCXVBTY=$PIECE($GET(^RCXV(RCXVBTN,0)),U,4)
+8 SET RCXVSEQ=$PIECE($GET(^RCXV(RCXVBTN,0)),U,5)
+9 SET RCXVSTOT=$PIECE($GET(^RCXV(RCXVBTN,0)),U,6)
+10 SET RCXVLDOM=$PIECE($GET(^RC(342,1,20)),U,8)
+11 ;S RCXVLEG=+$P($G(^RC(342,1,20)),U,7)
+12 ;
+13 IF RCSTAT'="T"
Begin DoDot:2
+14 IF $GET(RCXVSEQ)=""
SET RQFL=1
QUIT
+15 IF $PIECE(^RCXV(RCXVBTN,0),U,3)="C"
SET RQFL=1
QUIT
+16 SET RCXVUP(348.4,RCXVBTN_",",.03)="T"
+17 DO FILE^DIE("I","RCXVUP","RCXVERR")
+18 KILL RCXVUP
End DoDot:2
if RQFL
QUIT
+19 ;
+20 ; If a file has been transmitted but no acknowledgement
+21 ; has been received after 5 days, resend
+22 IF RCSTAT="T"
Begin DoDot:2
+23 SET RCXVTRD=$PIECE($GET(^RCXV(RCXVBTN,0)),U,8)\1
+24 SET RCXVARD=$PIECE($GET(^RCXV(RCXVBTN,0)),U,9)\1
+25 IF $$FMADD^XLFDT(RCXVTRD,5)>DT
SET RQFL=1
+26 ;I RCXVARD=0,RCXVLEG,RCXVTRD'=0 S RQFL=1
End DoDot:2
if RQFL
QUIT
+27 ;
+28 if RQFL
QUIT
+29 ; FILENAME=SITE_DATE_BATCH#
+30 SET RCXVFILE="RCXV"_RCXVSITE_RCXVBDT_RCXVBTN_".TXT"
+31 SET RCXVSCR="TMP_RCXV"_RCXVSITE_"_"_RCXVBTN
+32 DO OPEN^%ZISH("RCXVHNDL",RCXVDIR,RCXVFILE,"W")
+33 USE IO
+34 SET RCXVDMN=$PIECE($GET(^XTV(8989.3,1,0)),U,1)
+35 SET RCXVDMN=$PIECE($GET(^DIC(4.2,RCXVDMN,0)),U,1)
+36 ; # OF REC FOR BILLS
SET RCXVRN=$PIECE($GET(^RCXV(RCXVBTN,1,0)),U,4)
+37 ; # REC DEP/REC
IF RCXVRN=""
SET RCXVRN=$PIECE($GET(^RCXV(RCXVBTN,2,0)),U,4)
+38 ; TYPE OF DATA
SET RCXVRT=$PIECE($GET(^RCXV(RCXVBTN,0)),U,4)
+39 WRITE "HDR:"_RCXVSITE_RCXVU_RCXVDMN_RCXVU_RCXVRT_RCXVU_RCXVRN_RCXVU_RCXVBDT_RCXVU_RCXVXDT_RCXVU_RCXVSEQ_RCXVU_RCXVSTOT_RCXVU_RCXVLDOM,!
+40 FOR
SET RCXVBLN=$ORDER(^RCXV(RCXVBTN,1,RCXVBLN))
if 'RCXVBLN
QUIT
Begin DoDot:2
+41 SET DFN=$PIECE(^RCXV(RCXVBTN,1,RCXVBLN,0),U,2)
+42 DO EN^RCXVDC
End DoDot:2
+43 ;
+44 SET RCXVD0=0
+45 FOR
SET RCXVD0=$ORDER(^RCXV(RCXVBTN,2,RCXVD0))
if 'RCXVD0
QUIT
Begin DoDot:2
+46 SET RCXVEDT=$PIECE($GET(^RCY(344,RCXVD0,0)),U,12)\1
+47 DO D344^RCXVDC8
End DoDot:2
+48 ;
+49 SET RCXVD0=0
+50 FOR
SET RCXVD0=$ORDER(^RCXV(RCXVBTN,3,RCXVD0))
if 'RCXVD0
QUIT
Begin DoDot:2
+51 SET DFN=RCXVD0
+52 DO D3547^RCXVDC10
End DoDot:2
+53 ;
+54 IF $DATA(^RCXV(RCXVBTN,4))
SET RCXVMO=$GET(^(4))
DO PREREG^RCXVDC10
+55 ;
+56 IF $DATA(^RCXV(RCXVBTN,5))
SET RCXVMO=$GET(^(5))
DO BUFFER^RCXVDC10
+57 ;
+58 DO CLOSE^%ZISH("RCXVHNDL")
+59 ;
+60 SET $PIECE(^RC(342,1,20),U,9)=$$NOW^XLFDT()
+61 ;
+62 ; FTP directly to ARC
+63 DO EN^RCXVFTP(RCXVFILE,RCXVDIR)
End DoDot:1
+64 ;
+65 ; Check on FTP transfer messages
+66 DO ^RCXVFTR
+67 ;
+68 LOCK -^RCXVTSK
EXIT DO MSG^RCXVCHK
+1 KILL IEN,DIK,DA,RCXVBLN,RCXVBTN,RCSTAT,RCXVBDT,RCXVDMN,RCXVXDT,RCXVTRD
+2 KILL RCXVSITE,RCXVFILE,RCXVRN,RCXVRT,RCXVDIR,RCXVATP,RCXVU,DTACT,RBSQ,RBTOT
+3 KILL RCFDATE,RCXVCFLG,RCXVDBN,RCXVIDT,RCXVSEQ,RCXVSTOT,RCXVTRD,CCT,DTENT
+4 KILL RCBLN,RCDBTR,RCDEBT,RCTRAN,RCXVTR,RCBCN,RCXVPFDT,RCXVPTDT,RCXRMB
+5 KILL RCXVLDOM,RCXVARD,RCXVSUB,RCXVBTY,RCXVLEG,RCXVSCR,Y,X,RCXVMO
+6 KILL ^TMP("RCXVMSG",$JOB),^TMP("RCXVA",$JOB),^TMP("RCXVIN",$JOB)
+7 QUIT
+8 ;
HIS ; Historical data extract
+1 ;
+2 LOCK +^RCXVTSK:60
IF '$TEST
HANG 600
GOTO HIS
+3 ;
+4 IF $GET(DT)=""
DO DT^DICRW
+5 ;
+6 IF $GET(RCXVFFD)=""
Begin DoDot:1
+7 SET RCFDATE=$$FYCY^IBCU8(DT)
+8 SET RCXVFFD=$PIECE(RCFDATE,U,3)
SET RCXVFTD=$PIECE(RCFDATE,U,4)
End DoDot:1
+9 ;
+10 SET RCXVDAT=RCXVFFD-.01
+11 FOR
SET RCXVDAT=$ORDER(^PRCA(430,"ACTDT",RCXVDAT))
if RCXVDAT=""!(RCXVDAT>RCXVFTD)
QUIT
Begin DoDot:1
+12 SET IEN=""
+13 FOR
SET IEN=$ORDER(^PRCA(430,"ACTDT",RCXVDAT,IEN))
if IEN=""
QUIT
Begin DoDot:2
+14 IF $PIECE(^PRCA(430,IEN,0),U,8)=16!($PIECE(^PRCA(430,IEN,0),U,8)=40)
QUIT
+15 SET RCXVBLN=IEN
SET DFN=$PIECE(^PRCA(430,IEN,0),U,7)
+16 DO FIL^RCXVDEQ("H")
End DoDot:2
End DoDot:1
+17 ;
+18 LOCK -^RCXVTSK
+19 ;
+20 DO EN
+21 KILL RCXVDAT,RCFDATE,RCXVFFD,RCXVFTD,IEN,DFN,RCXVBLN
+22 ;
+23 QUIT
+24 ;
CUR ; Find all current fiscal year bills
+1 ;
+2 LOCK +^RCXVTSK:60
IF '$TEST
HANG 600
GOTO CUR
+3 ;
+4 SET TTYP=""
+5 FOR
SET TTYP=$ORDER(^PRCA(433,"AT",TTYP))
if TTYP=""
QUIT
Begin DoDot:1
+6 IF '+$PIECE(^PRCA(430.3,TTYP,0),U,6)
QUIT
+7 SET RDATE=RCXVFFD-.01
+8 FOR
SET RDATE=$ORDER(^PRCA(433,"AT",TTYP,RDATE))
if RDATE=""!(RDATE\1>RCXVFTD)
QUIT
Begin DoDot:2
+9 SET IEN=""
+10 FOR
SET IEN=$ORDER(^PRCA(433,"AT",TTYP,RDATE,IEN))
if IEN=""
QUIT
Begin DoDot:3
+11 SET RCXVBLN=$PIECE(^PRCA(433,IEN,0),U,2)
+12 IF RCXVBLN=""
QUIT
+13 SET X=$PIECE($GET(^PRCA(430,RCXVBLN,0)),U,8)
+14 IF X=16!(X=40)
QUIT
+15 ; Line below changed for patch 228 to do FY05 extract
+16 DO FIL^RCXVDEQ("E")
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 LOCK -^RCXVTSK
+19 ;
+20 DO EN
+21 KILL TTYP,RDATE,RCXVFFD,RCXVFTD,RCXVBLN
+22 QUIT
+23 ;
ACT ; Active data extract
+1 ;
+2 LOCK +^RCXVTSK:60
IF '$TEST
HANG 600
GOTO ACT
+3 ;
+4 NEW STAT,CSTAT,QFL
+5 ; Set up the AR Data Queue for all 'Active' and 'Suspended' bills
+6 FOR STAT=16,40
SET IEN=""
FOR
SET IEN=$ORDER(^PRCA(430,"AC",STAT,IEN))
if IEN=""
QUIT
Begin DoDot:1
+7 SET RCXVBLN=IEN
SET DFN=$PIECE(^PRCA(430,IEN,0),U,7)
+8 IF $PIECE(^PRCA(430,IEN,0),U,2)=""
QUIT
+9 SET CSTAT=$PIECE(^PRCA(430,IEN,0),U,8)
+10 IF CSTAT'=STAT
SET QFL=0
Begin DoDot:2
+11 IF CSTAT'=16!(CSTAT'=40)
SET QFL=1
End DoDot:2
if QFL
QUIT
+12 DO FIL^RCXVDEQ("A")
End DoDot:1
+13 ;
+14 LOCK -^RCXVTSK
+15 ;
+16 DO EN
+17 QUIT
+18 ;
ER ; Unlock and log error
+1 LOCK -^RCXVTSK
+2 DO ^%ZTER
+3 DO UNWIND^%ZTER
+4 QUIT
