- 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 Jan 18, 2025@02:49:20 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())