RCRJRCO ;WISC/RFJ-control collection of monthly data ;1 Nov 97
;;4.5;Accounts Receivable;**96,106,101,103,147,156,169,170,174,191,203,239**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
; called by menu option to regenerate monthly data
N %,%DT,%X,%Y,DA347,DIQ2,DATEMOYR,FMSDOCNO,GECSDATA,LASTMONT,RCRJFAR1,RCRJFAR2,RCRJFBDR,RCRJFOIG,RCRJFSV,RCRJFTR,RCRJFWR,X,Y,ZTSK,RCNOHSIF
;
S RCNOHSIF=$$NOHSIF() ; HSIF is disabed
;
W !!,"This option will re-run the AR Data Collector, extracting data from"
W !,"the AR database and sending the data to the National Database and FMS."
W !,"It will also re-generate the Bad Debt Report and the OIG Extract."
W !!,"This option will perform the following tasks:",!
W !," 1. Re-send the data to the National Database. The data will only be"
W !," re-sent if you answer YES to the prompt. The data will only be"
W !," accepted in the NDB if the month-year has not been closed (in the NDB)."
W !," 2. Re-send the data to FMS on the SV and WR documents. The data"
W !," will only be re-sent if it has not been previously accepted by FMS."
W !," 3. Re-send the OIG Extract. If the selected month is the end of the"
W !," quarter (December, March, June, or September), the OIG Extract can"
W !," be re-generated."
;
; do not allow dates in future to be selected
;S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
I $E(DT,6,7)'>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$E($$LDATE^RCRJR(DT),1,5)_"00"
S %DT(0)=-LASTMONT
S %DT("A")="Retransmit AR Data Collector data for Month/Year: "
S %DT="AEMP"
W ! D ^%DT
I Y<1 Q
;
S (DATEMOYR,Y)=$E(Y,1,5)_"00" D DD^%DT
;
; try and find SV document to see if its accepted
K GECSDATA
D KEYLOOK^GECSSGET("SV-"_DATEMOYR,1)
I $G(GECSDATA) D Q:'$G(GECSDATA)
. W !!,"The SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
. . W !,"The SV document has been ACCEPTED in FMS and will not be resent."
. . S RCRJFSV=1
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
. . W !,"The SV document has REJECTED and will be RETRANSMITTED."
. W !,"The SV document has NOT been ACCEPTED in FMS."
. S %=$$ASKTRANS I %<0 K GECSDATA Q
. I %'=1 S RCRJFSV=1 ;do not send document
;
; try and find WR document to see if its accepted
K GECSDATA
D KEYLOOK^GECSSGET("WR-"_DATEMOYR,1)
I $G(GECSDATA) D Q:'$G(GECSDATA)
. W !!,"The WR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
. . W !,"The WR document has been ACCEPTED in FMS and will not be resent."
. . S RCRJFWR=1
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
. . W !,"The WR document has REJECTED and will be RETRANSMITTED."
. W !,"The WR document has NOT been ACCEPTED in FMS."
. S %=$$ASKTRANS I %<0 K GECSDATA Q
. I %'=1 S RCRJFWR=1 ;do not send document
;
; try and find the Bad Debt SV document to see if its accepted
K GECSDATA
D KEYLOOK^GECSSGET("SV-"_$E(DATEMOYR,1,5)_"01",1)
I $G(GECSDATA) D Q:'$G(GECSDATA)
. W !!,"The Bad Debt SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
. . W !,"The Bad Debt SV document has been ACCEPTED in FMS and will not be resent."
. . S RCRJFBDR=1
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
. . W !,"The Bad Debt SV document has REJECTED and will be RETRANSMITTED."
. W !,"The Bad Debt SV document has NOT been ACCEPTED in FMS."
. S %=$$ASKTRANS I %<0 K GECSDATA Q
. I %'=1 S RCRJFBDR=1 ;do not send document
;
; try and find TR document to see if its accepted
K GECSDATA
I 'RCNOHSIF D KEYLOOK^GECSSGET("TR-"_DATEMOYR,1)
I $G(GECSDATA) D Q:'$G(GECSDATA)
. W !!,"The TR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
. . W !,"The TR document has been ACCEPTED in FMS and will not be resent."
. . S RCRJFTR=1
. I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
. . W !,"The TR document has REJECTED and will be RETRANSMITTED."
. W !,"The TR document has NOT been ACCEPTED in FMS."
. S %=$$ASKTRANS I %<0 K GECSDATA Q
. I %'=1 S RCRJFTR=1 ;do not send document
;
I RCNOHSIF S RCRJFTR=1 ;do not send TR if disabled
;
; ask to resend AR1 NDB data
S %=$$ASKNDB("AR1") I %<0 Q
I %'=1 S RCRJFAR1=1 ;do not send to ndb
;
; ask to resend AR2 NDB data
S %=$$ASKNDB("AR2") I %<0 Q
I %'=1 S RCRJFAR2=1 ;do not send to ndb
;
; ask to resend the OIG extract
S RCRJFOIG=1 ; resend the OIG extract
D I %<0 Q
. S %=$$ASKOIG I %<0 Q
. I %=1 S RCRJFOIG=0 ;re-send oig extract
;
;
I $G(RCRJFAR1),$G(RCRJFAR2),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) W !!,"No reports have been selected for retransmission." Q
;
W !!,"This option will retransmit the following monthly reports:"
I '$G(RCRJFAR1) W !," AR1 to the NDB."
I '$G(RCRJFAR2) W !," AR2 to the NDB."
I '$G(RCRJFSV) W !," SV document to FMS."
I '$G(RCRJFWR) W !," WR document to FMS."
I '$G(RCRJFTR) W !," TR document to FMS."
I '$G(RCRJFBDR) W !," rebuild the Bad Debt Report."
I '$G(RCRJFOIG) W !," resend the OIG Extract."
;
I $$ASKOKAY(DATEMOYR)=1 D
. W !!,"This will be queued to run in the background. When it completes,"
. W !,"a mail message will be sent to the mail group RC AR DATA COLLECTOR."
. S ZTDESC="AR Data Collector",ZTRTN="DQ^RCRJRCO",ZTDTH=$H,ZTIO=""
. S ZTSAVE("DATEMOYR")="",ZTSAVE("RCRJF*")="",ZTSAVE("ZTREQ")="@"
. D ^%ZTLOAD
. W !!,"Queued to run in task ",$G(ZTSK)
Q
;
;
DQ ; start collection of monthly data
; datemoyr is for the month and year to run collector (ex 2971000)
; rcrjfsv and rcrjfwr are flags to stop the sv and wr documents
; rcrjfbdr is a flag to stop the rebuild of the bad debt report
N %,DATEBEG,DATEEND,PRCASITE,X
;
I $$NOHSIF() S RCRJFTR=1 ; disable TR to FMS
; get last month
I $G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DATEMOYR)
I '$G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DT),DATEMOYR=$E(DATEEND,1,5)_"00"
;
;S DATEBEG=$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1
S DATEBEG=$S(+$E(DATEEND,2,5)=309:$E(DATEEND,1,5)_"01",1:$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1)
;S DATEEND=$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(DATEMOYR,4,5)) I DATEEND=28,((17+$E(DATEMOYR))_$E(DATEMOYR,2,3))#4=0 S DATEEND=29
;S DATEEND=$$LDATE^RCRJR(DT)
;S DATEEND=$E(DATEMOYR,1,5)_DATEEND
;
S PRCASITE=$$SITE^RCMSITE
;
; queue the AR2 data collector to run in the background
I '$G(RCRJFAR2) D
. S ZTDESC="AR2 Data Collector",ZTRTN="DQ^RCRJRCO2",ZTDTH=$H,ZTIO=""
. S ZTSAVE("PRCASITE")="",ZTSAVE("DATEBEG")="",ZTSAVE("DATEEND")="",ZTSAVE("ZTREQ")="@"
. D ^%ZTLOAD
;
; no point in running data collector, nothing being sent
I $G(RCRJFAR1),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) Q
;
; run the AR1 data collector
D START^RCRJRCOL(PRCASITE,DATEBEG,DATEEND)
Q
;
;
ASKNDB(REPORT) ; ask to resend to national database
; report = AR1 or AR2
; 1 is yes, otherwise no
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Do you want to resend the "_REPORT_" data to the National Database"
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
;
ASKBDR() ; ask to rebuild the bad debt report
; 1 is yes, otherwise no
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Do you want to rebuild the Bad Debt Report"
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
;
ASKOKAY(DATEMOYR) ; ask if its okay
; 1 is yes, otherwise no
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S Y=DATEMOYR D DD^%DT
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Are you SURE you want to regenerate the data for "_Y
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
;
ASKTRANS() ; ask if its okay to retransmit document to FMS
; 1 is yes, otherwise no
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S Y=DATEMOYR D DD^%DT
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Do you want to regenerate and retransmit this document to FMS"
D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
;
ASKOIG() ; ask to resend to oig
; 1 is yes, otherwise no
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")=" Do you want to resend the data to the OIG"
W ! D ^DIR
I $G(DTOUT)!($G(DUOUT)) S Y=-1
Q Y
;
;The Date when AAC is ready for Point Accounts:
PAEFFDT() Q 3031001 ;10/1/2003
;
; The Data Collector cannot send 5287 Point Accounts before the Effective Date
; This function adjusts the fund depending on the current date
ADJFUND(RCFUND) ;
I DT'<$$PAEFFDT() Q RCFUND ; Do nothing after the effective date
I $E(RCFUND,1,4)=5287 Q 5287 ; No point accounts before the effective date
Q RCFUND
;
; The function returns 1 if MCCF-HSIF transfer is disabled
NOHSIF() ;
Q (DT'<$$PAEFFDT()) ; Disabled after the AAC is ready.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRCO 9408 printed Dec 13, 2024@01:48:07 Page 2
RCRJRCO ;WISC/RFJ-control collection of monthly data ;1 Nov 97
+1 ;;4.5;Accounts Receivable;**96,106,101,103,147,156,169,170,174,191,203,239**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ; called by menu option to regenerate monthly data
+4 NEW %,%DT,%X,%Y,DA347,DIQ2,DATEMOYR,FMSDOCNO,GECSDATA,LASTMONT,RCRJFAR1,RCRJFAR2,RCRJFBDR,RCRJFOIG,RCRJFSV,RCRJFTR,RCRJFWR,X,Y,ZTSK,RCNOHSIF
+5 ;
+6 ; HSIF is disabed
SET RCNOHSIF=$$NOHSIF()
+7 ;
+8 WRITE !!,"This option will re-run the AR Data Collector, extracting data from"
+9 WRITE !,"the AR database and sending the data to the National Database and FMS."
+10 WRITE !,"It will also re-generate the Bad Debt Report and the OIG Extract."
+11 WRITE !!,"This option will perform the following tasks:",!
+12 WRITE !," 1. Re-send the data to the National Database. The data will only be"
+13 WRITE !," re-sent if you answer YES to the prompt. The data will only be"
+14 WRITE !," accepted in the NDB if the month-year has not been closed (in the NDB)."
+15 WRITE !," 2. Re-send the data to FMS on the SV and WR documents. The data"
+16 WRITE !," will only be re-sent if it has not been previously accepted by FMS."
+17 WRITE !," 3. Re-send the OIG Extract. If the selected month is the end of the"
+18 WRITE !," quarter (December, March, June, or September), the OIG Extract can"
+19 WRITE !," be re-generated."
+20 ;
+21 ; do not allow dates in future to be selected
+22 ;S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
+23 IF $EXTRACT(DT,6,7)'>$EXTRACT($$LDATE^RCRJR(DT),6,7)
SET (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
+24 IF $EXTRACT(DT,6,7)>$EXTRACT($$LDATE^RCRJR(DT),6,7)
SET (LASTMONT,DATEMOYR)=$EXTRACT($$LDATE^RCRJR(DT),1,5)_"00"
+25 SET %DT(0)=-LASTMONT
+26 SET %DT("A")="Retransmit AR Data Collector data for Month/Year: "
+27 SET %DT="AEMP"
+28 WRITE !
DO ^%DT
+29 IF Y<1
QUIT
+30 ;
+31 SET (DATEMOYR,Y)=$EXTRACT(Y,1,5)_"00"
DO DD^%DT
+32 ;
+33 ; try and find SV document to see if its accepted
+34 KILL GECSDATA
+35 DO KEYLOOK^GECSSGET("SV-"_DATEMOYR,1)
+36 IF $GET(GECSDATA)
Begin DoDot:1
+37 WRITE !!,"The SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
+38 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="A"
Begin DoDot:2
+39 WRITE !,"The SV document has been ACCEPTED in FMS and will not be resent."
+40 SET RCRJFSV=1
End DoDot:2
QUIT
+41 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="R"
Begin DoDot:2
+42 WRITE !,"The SV document has REJECTED and will be RETRANSMITTED."
End DoDot:2
QUIT
+43 WRITE !,"The SV document has NOT been ACCEPTED in FMS."
+44 SET %=$$ASKTRANS
IF %<0
KILL GECSDATA
QUIT
+45 ;do not send document
IF %'=1
SET RCRJFSV=1
End DoDot:1
if '$GET(GECSDATA)
QUIT
+46 ;
+47 ; try and find WR document to see if its accepted
+48 KILL GECSDATA
+49 DO KEYLOOK^GECSSGET("WR-"_DATEMOYR,1)
+50 IF $GET(GECSDATA)
Begin DoDot:1
+51 WRITE !!,"The WR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
+52 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="A"
Begin DoDot:2
+53 WRITE !,"The WR document has been ACCEPTED in FMS and will not be resent."
+54 SET RCRJFWR=1
End DoDot:2
QUIT
+55 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="R"
Begin DoDot:2
+56 WRITE !,"The WR document has REJECTED and will be RETRANSMITTED."
End DoDot:2
QUIT
+57 WRITE !,"The WR document has NOT been ACCEPTED in FMS."
+58 SET %=$$ASKTRANS
IF %<0
KILL GECSDATA
QUIT
+59 ;do not send document
IF %'=1
SET RCRJFWR=1
End DoDot:1
if '$GET(GECSDATA)
QUIT
+60 ;
+61 ; try and find the Bad Debt SV document to see if its accepted
+62 KILL GECSDATA
+63 DO KEYLOOK^GECSSGET("SV-"_$EXTRACT(DATEMOYR,1,5)_"01",1)
+64 IF $GET(GECSDATA)
Begin DoDot:1
+65 WRITE !!,"The Bad Debt SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
+66 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="A"
Begin DoDot:2
+67 WRITE !,"The Bad Debt SV document has been ACCEPTED in FMS and will not be resent."
+68 SET RCRJFBDR=1
End DoDot:2
QUIT
+69 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="R"
Begin DoDot:2
+70 WRITE !,"The Bad Debt SV document has REJECTED and will be RETRANSMITTED."
End DoDot:2
QUIT
+71 WRITE !,"The Bad Debt SV document has NOT been ACCEPTED in FMS."
+72 SET %=$$ASKTRANS
IF %<0
KILL GECSDATA
QUIT
+73 ;do not send document
IF %'=1
SET RCRJFBDR=1
End DoDot:1
if '$GET(GECSDATA)
QUIT
+74 ;
+75 ; try and find TR document to see if its accepted
+76 KILL GECSDATA
+77 IF 'RCNOHSIF
DO KEYLOOK^GECSSGET("TR-"_DATEMOYR,1)
+78 IF $GET(GECSDATA)
Begin DoDot:1
+79 WRITE !!,"The TR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
+80 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="A"
Begin DoDot:2
+81 WRITE !,"The TR document has been ACCEPTED in FMS and will not be resent."
+82 SET RCRJFTR=1
End DoDot:2
QUIT
+83 IF $EXTRACT($GET(GECSDATA(2100.1,GECSDATA,3,"E")))="R"
Begin DoDot:2
+84 WRITE !,"The TR document has REJECTED and will be RETRANSMITTED."
End DoDot:2
QUIT
+85 WRITE !,"The TR document has NOT been ACCEPTED in FMS."
+86 SET %=$$ASKTRANS
IF %<0
KILL GECSDATA
QUIT
+87 ;do not send document
IF %'=1
SET RCRJFTR=1
End DoDot:1
if '$GET(GECSDATA)
QUIT
+88 ;
+89 ;do not send TR if disabled
IF RCNOHSIF
SET RCRJFTR=1
+90 ;
+91 ; ask to resend AR1 NDB data
+92 SET %=$$ASKNDB("AR1")
IF %<0
QUIT
+93 ;do not send to ndb
IF %'=1
SET RCRJFAR1=1
+94 ;
+95 ; ask to resend AR2 NDB data
+96 SET %=$$ASKNDB("AR2")
IF %<0
QUIT
+97 ;do not send to ndb
IF %'=1
SET RCRJFAR2=1
+98 ;
+99 ; ask to resend the OIG extract
+100 ; resend the OIG extract
SET RCRJFOIG=1
+101 Begin DoDot:1
+102 SET %=$$ASKOIG
IF %<0
QUIT
+103 ;re-send oig extract
IF %=1
SET RCRJFOIG=0
End DoDot:1
IF %<0
QUIT
+104 ;
+105 ;
+106 IF $GET(RCRJFAR1)
IF $GET(RCRJFAR2)
IF $GET(RCRJFSV)
IF $GET(RCRJFWR)
IF $GET(RCRJFTR)
IF $GET(RCRJFBDR)
IF $GET(RCRJFOIG)
WRITE !!,"No reports have been selected for retransmission."
QUIT
+107 ;
+108 WRITE !!,"This option will retransmit the following monthly reports:"
+109 IF '$GET(RCRJFAR1)
WRITE !," AR1 to the NDB."
+110 IF '$GET(RCRJFAR2)
WRITE !," AR2 to the NDB."
+111 IF '$GET(RCRJFSV)
WRITE !," SV document to FMS."
+112 IF '$GET(RCRJFWR)
WRITE !," WR document to FMS."
+113 IF '$GET(RCRJFTR)
WRITE !," TR document to FMS."
+114 IF '$GET(RCRJFBDR)
WRITE !," rebuild the Bad Debt Report."
+115 IF '$GET(RCRJFOIG)
WRITE !," resend the OIG Extract."
+116 ;
+117 IF $$ASKOKAY(DATEMOYR)=1
Begin DoDot:1
+118 WRITE !!,"This will be queued to run in the background. When it completes,"
+119 WRITE !,"a mail message will be sent to the mail group RC AR DATA COLLECTOR."
+120 SET ZTDESC="AR Data Collector"
SET ZTRTN="DQ^RCRJRCO"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+121 SET ZTSAVE("DATEMOYR")=""
SET ZTSAVE("RCRJF*")=""
SET ZTSAVE("ZTREQ")="@"
+122 DO ^%ZTLOAD
+123 WRITE !!,"Queued to run in task ",$GET(ZTSK)
End DoDot:1
+124 QUIT
+125 ;
+126 ;
DQ ; start collection of monthly data
+1 ; datemoyr is for the month and year to run collector (ex 2971000)
+2 ; rcrjfsv and rcrjfwr are flags to stop the sv and wr documents
+3 ; rcrjfbdr is a flag to stop the rebuild of the bad debt report
+4 NEW %,DATEBEG,DATEEND,PRCASITE,X
+5 ;
+6 ; disable TR to FMS
IF $$NOHSIF()
SET RCRJFTR=1
+7 ; get last month
+8 IF $GET(DATEMOYR)
SET DATEEND=$$LDATE^RCRJR(DATEMOYR)
+9 IF '$GET(DATEMOYR)
SET DATEEND=$$LDATE^RCRJR(DT)
SET DATEMOYR=$EXTRACT(DATEEND,1,5)_"00"
+10 ;
+11 ;S DATEBEG=$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1
+12 SET DATEBEG=$SELECT(+$EXTRACT(DATEEND,2,5)=309:$EXTRACT(DATEEND,1,5)_"01",1:$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1)
+13 ;S DATEEND=$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(DATEMOYR,4,5)) I DATEEND=28,((17+$E(DATEMOYR))_$E(DATEMOYR,2,3))#4=0 S DATEEND=29
+14 ;S DATEEND=$$LDATE^RCRJR(DT)
+15 ;S DATEEND=$E(DATEMOYR,1,5)_DATEEND
+16 ;
+17 SET PRCASITE=$$SITE^RCMSITE
+18 ;
+19 ; queue the AR2 data collector to run in the background
+20 IF '$GET(RCRJFAR2)
Begin DoDot:1
+21 SET ZTDESC="AR2 Data Collector"
SET ZTRTN="DQ^RCRJRCO2"
SET ZTDTH=$HOROLOG
SET ZTIO=""
+22 SET ZTSAVE("PRCASITE")=""
SET ZTSAVE("DATEBEG")=""
SET ZTSAVE("DATEEND")=""
SET ZTSAVE("ZTREQ")="@"
+23 DO ^%ZTLOAD
End DoDot:1
+24 ;
+25 ; no point in running data collector, nothing being sent
+26 IF $GET(RCRJFAR1)
IF $GET(RCRJFSV)
IF $GET(RCRJFWR)
IF $GET(RCRJFTR)
IF $GET(RCRJFBDR)
IF $GET(RCRJFOIG)
QUIT
+27 ;
+28 ; run the AR1 data collector
+29 DO START^RCRJRCOL(PRCASITE,DATEBEG,DATEEND)
+30 QUIT
+31 ;
+32 ;
ASKNDB(REPORT) ; ask to resend to national database
+1 ; report = AR1 or AR2
+2 ; 1 is yes, otherwise no
+3 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+4 SET DIR(0)="YO"
SET DIR("B")="NO"
+5 SET DIR("A")=" Do you want to resend the "_REPORT_" data to the National Database"
+6 WRITE !
DO ^DIR
+7 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+8 QUIT Y
+9 ;
+10 ;
ASKBDR() ; ask to rebuild the bad debt report
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Do you want to rebuild the Bad Debt Report"
+5 WRITE !
DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 QUIT Y
+8 ;
+9 ;
ASKOKAY(DATEMOYR) ; ask if its okay
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+3 SET Y=DATEMOYR
DO DD^%DT
+4 SET DIR(0)="YO"
SET DIR("B")="NO"
+5 SET DIR("A")=" Are you SURE you want to regenerate the data for "_Y
+6 WRITE !
DO ^DIR
+7 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+8 QUIT Y
+9 ;
+10 ;
ASKTRANS() ; ask if its okay to retransmit document to FMS
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+3 SET Y=DATEMOYR
DO DD^%DT
+4 SET DIR(0)="YO"
SET DIR("B")="NO"
+5 SET DIR("A")=" Do you want to regenerate and retransmit this document to FMS"
+6 DO ^DIR
+7 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+8 QUIT Y
+9 ;
+10 ;
ASKOIG() ; ask to resend to oig
+1 ; 1 is yes, otherwise no
+2 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")=" Do you want to resend the data to the OIG"
+5 WRITE !
DO ^DIR
+6 IF $GET(DTOUT)!($GET(DUOUT))
SET Y=-1
+7 QUIT Y
+8 ;
+9 ;The Date when AAC is ready for Point Accounts:
PAEFFDT() ;10/1/2003
QUIT 3031001
+1 ;
+2 ; The Data Collector cannot send 5287 Point Accounts before the Effective Date
+3 ; This function adjusts the fund depending on the current date
ADJFUND(RCFUND) ;
+1 ; Do nothing after the effective date
IF DT'<$$PAEFFDT()
QUIT RCFUND
+2 ; No point accounts before the effective date
IF $EXTRACT(RCFUND,1,4)=5287
QUIT 5287
+3 QUIT RCFUND
+4 ;
+5 ; The function returns 1 if MCCF-HSIF transfer is disabled
NOHSIF() ;
+1 ; Disabled after the AAC is ready.
QUIT (DT'<$$PAEFFDT())
