RCXVP228 ;DAOU/ALA-AR Data Extraction Post-Install Program ;23-JUL-03
;;4.5;Accounts Receivable;**228**;Mar 20, 1995
;
;** Program Description **
; This program will be run on installation of patch
; PRCA*4.5*228 for CBO to ARC Data Extractions (FY05)
;
EN ; Entry Point
NEW RCXVX,RCXVCFLG,X,RCXVOID
;
S:'$G(RCQDT) RCQDT=DT
; Reset CBO Flag field to for bills in OPEN status to "INCLUDE"
S $P(^PRCA(430.3,42,0),U,6)=1
;
ACT ;Queue up active bill transmission
D P228^RCXVP201
CUR ; Set up records from installation date until end of Fiscal Year 2004
N VALUE,DIERR,Z,X,Y
S VALUE="PRCA*4.5*201"
D FIND^DIC(9.7,"","@;.01;17IE","P",VALUE,"","","","","Z")
S RCXVX=0,RCXVFFD="",RCXVOID=""
F S RCXVX=$O(Z("DILIST",RCXVX)) Q:'RCXVX D Q:RCXVFFD
. S RCXVFFD=$P(Z("DILIST",RCXVX,0),U,3)
. Q:'RCXVFFD
. S RCXVFFD=$P(RCXVFFD,".")
. Q
I 'RCXVFFD!(RCXVFFD>3040927) S RCXVFFD=3040825
S (RCXVOID,X)=RCXVFFD
S RCXVDSC="CBO FISCAL YR 2004 ("_+$E(X,4,5)_"/"_+$E(X,6,7)_"/"_$E(X,2,3)_"-9/27/04)"
S RCXVFTD=3040927,RFDATE=$$SAT^RCXVUTIL(DT),RCXVCFLG=1 D TSK
;
; Set up records since the end of the Fiscal Year 2004
S RCXVDSC="CBO FISCAL YR 2005 (9/28/04-12/31/04)"
S RCXVFFD=3040928,RCXVFTD=3041231,RCXVCFLG=1 D TSK
;
S RCXVDSC="CBO FISCAL YR 2005 (1/1/05-3/31/05)"
S RCXVFFD=3050101,RCXVFTD=3050331,RCXVCFLG=1 D TSK
;
S RCXVDSC="CBO FISCAL YR 2005 (4/1/05-6/30/05)"
S RCXVFFD=3050401,RCXVFTD=3050630,RCXVCFLG=1 D TSK
G FY04:RCQDT<3050701
;
S RCXVDSC="CBO FISCAL YR 2005 (7/1/05-"_+$E(RCQDT,4,5)_"/"_+$E(RCQDT,6,7)_"/"_$E(RCQDT,2,3)_")"
S RCXVFFD=3050701,RCXVFTD=RCQDT,RCXVCFLG=1 D TSK
;
FY04 ;
S RCXVDSC="CBO FISCAL YR 2004 (9/26/03-12/31/03)"
S RCXVFFD=3030927,RCXVFTD=3031231,RCXVCFLG=1 D TSK
;
S RCXVDSC="CBO FISCAL YR 2004 (1/1/04-3/31/04)"
S RCXVFFD=3040101,RCXVFTD=3040331,RCXVCFLG=1 D TSK
;
S RCXVDSC="CBO FISCAL YR 2004 (4/1/04-6/30/04)"
S RCXVFFD=3040401,RCXVFTD=3040630,RCXVCFLG=1 D TSK
;
S X1=RCXVOID,X2=-1 D C^%DTC
S RCXVDSC="CBO FISCAL YR 2004 (7/1/04-"_+$E(X,4,5)_"/"_+$E(X,6,7)_"/"_$E(X,2,3)_")"
S RCXVFFD=3040701,RCXVFTD=3040927,RCXVCFLG=1 D TSK
EXIT K RCXVDSC,RTASKS,ZTDESC,ZTRTN,ZTDTH,XPDQUES,RCXVFFD,RCXVFTD
K RCXFY03,RCXVFL,RFDATE,TIME,ZTSAVE,ZTIO,RCXVCFLG,RCQDT
Q
;
TSK ; Set up Task for current fiscal year 2005
S ZTDESC=RCXVDSC,ZTRTN="CUR^RCXVTSK",ZTIO=""
S ZTSAVE("RCXVFFD")="",ZTSAVE("RCXVFTD")="",ZTSAVE("RCXVCFLG")=""
S ZTDTH=RFDATE_".06"
D ^%ZTLOAD
I RCXVFTD=3050630,RCQDT>3050630 S RFDATE=$$FMADD^XLFDT(RFDATE,1) Q
I RCXVFTD=RCQDT,RCQDT>3050630 S RFDATE=$$FMADD^XLFDT(RFDATE,6) Q
S RFDATE=$$FMADD^XLFDT(RFDATE,7)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXVP228 2673 printed Apr 09, 2024@20:49:11 Page 2
RCXVP228 ;DAOU/ALA-AR Data Extraction Post-Install Program ;23-JUL-03
+1 ;;4.5;Accounts Receivable;**228**;Mar 20, 1995
+2 ;
+3 ;** Program Description **
+4 ; This program will be run on installation of patch
+5 ; PRCA*4.5*228 for CBO to ARC Data Extractions (FY05)
+6 ;
EN ; Entry Point
+1 NEW RCXVX,RCXVCFLG,X,RCXVOID
+2 ;
+3 if '$GET(RCQDT)
SET RCQDT=DT
+4 ; Reset CBO Flag field to for bills in OPEN status to "INCLUDE"
+5 SET $PIECE(^PRCA(430.3,42,0),U,6)=1
+6 ;
ACT ;Queue up active bill transmission
+1 DO P228^RCXVP201
CUR ; Set up records from installation date until end of Fiscal Year 2004
+1 NEW VALUE,DIERR,Z,X,Y
+2 SET VALUE="PRCA*4.5*201"
+3 DO FIND^DIC(9.7,"","@;.01;17IE","P",VALUE,"","","","","Z")
+4 SET RCXVX=0
SET RCXVFFD=""
SET RCXVOID=""
+5 FOR
SET RCXVX=$ORDER(Z("DILIST",RCXVX))
if 'RCXVX
QUIT
Begin DoDot:1
+6 SET RCXVFFD=$PIECE(Z("DILIST",RCXVX,0),U,3)
+7 if 'RCXVFFD
QUIT
+8 SET RCXVFFD=$PIECE(RCXVFFD,".")
+9 QUIT
End DoDot:1
if RCXVFFD
QUIT
+10 IF 'RCXVFFD!(RCXVFFD>3040927)
SET RCXVFFD=3040825
+11 SET (RCXVOID,X)=RCXVFFD
+12 SET RCXVDSC="CBO FISCAL YR 2004 ("_+$EXTRACT(X,4,5)_"/"_+$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_"-9/27/04)"
+13 SET RCXVFTD=3040927
SET RFDATE=$$SAT^RCXVUTIL(DT)
SET RCXVCFLG=1
DO TSK
+14 ;
+15 ; Set up records since the end of the Fiscal Year 2004
+16 SET RCXVDSC="CBO FISCAL YR 2005 (9/28/04-12/31/04)"
+17 SET RCXVFFD=3040928
SET RCXVFTD=3041231
SET RCXVCFLG=1
DO TSK
+18 ;
+19 SET RCXVDSC="CBO FISCAL YR 2005 (1/1/05-3/31/05)"
+20 SET RCXVFFD=3050101
SET RCXVFTD=3050331
SET RCXVCFLG=1
DO TSK
+21 ;
+22 SET RCXVDSC="CBO FISCAL YR 2005 (4/1/05-6/30/05)"
+23 SET RCXVFFD=3050401
SET RCXVFTD=3050630
SET RCXVCFLG=1
DO TSK
+24 if RCQDT<3050701
GOTO FY04
+25 ;
+26 SET RCXVDSC="CBO FISCAL YR 2005 (7/1/05-"_+$EXTRACT(RCQDT,4,5)_"/"_+$EXTRACT(RCQDT,6,7)_"/"_$EXTRACT(RCQDT,2,3)_")"
+27 SET RCXVFFD=3050701
SET RCXVFTD=RCQDT
SET RCXVCFLG=1
DO TSK
+28 ;
FY04 ;
+1 SET RCXVDSC="CBO FISCAL YR 2004 (9/26/03-12/31/03)"
+2 SET RCXVFFD=3030927
SET RCXVFTD=3031231
SET RCXVCFLG=1
DO TSK
+3 ;
+4 SET RCXVDSC="CBO FISCAL YR 2004 (1/1/04-3/31/04)"
+5 SET RCXVFFD=3040101
SET RCXVFTD=3040331
SET RCXVCFLG=1
DO TSK
+6 ;
+7 SET RCXVDSC="CBO FISCAL YR 2004 (4/1/04-6/30/04)"
+8 SET RCXVFFD=3040401
SET RCXVFTD=3040630
SET RCXVCFLG=1
DO TSK
+9 ;
+10 SET X1=RCXVOID
SET X2=-1
DO C^%DTC
+11 SET RCXVDSC="CBO FISCAL YR 2004 (7/1/04-"_+$EXTRACT(X,4,5)_"/"_+$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_")"
+12 SET RCXVFFD=3040701
SET RCXVFTD=3040927
SET RCXVCFLG=1
DO TSK
EXIT KILL RCXVDSC,RTASKS,ZTDESC,ZTRTN,ZTDTH,XPDQUES,RCXVFFD,RCXVFTD
+1 KILL RCXFY03,RCXVFL,RFDATE,TIME,ZTSAVE,ZTIO,RCXVCFLG,RCQDT
+2 QUIT
+3 ;
TSK ; Set up Task for current fiscal year 2005
+1 SET ZTDESC=RCXVDSC
SET ZTRTN="CUR^RCXVTSK"
SET ZTIO=""
+2 SET ZTSAVE("RCXVFFD")=""
SET ZTSAVE("RCXVFTD")=""
SET ZTSAVE("RCXVCFLG")=""
+3 SET ZTDTH=RFDATE_".06"
+4 DO ^%ZTLOAD
+5 IF RCXVFTD=3050630
IF RCQDT>3050630
SET RFDATE=$$FMADD^XLFDT(RFDATE,1)
QUIT
+6 IF RCXVFTD=RCQDT
IF RCQDT>3050630
SET RFDATE=$$FMADD^XLFDT(RFDATE,6)
QUIT
+7 SET RFDATE=$$FMADD^XLFDT(RFDATE,7)
+8 QUIT
+9 ;
