- 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 Mar 13, 2025@20:54:24 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 ;
