Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCRJRCO

RCRJRCO.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ; called by menu option to regenerate monthly data
  1. N %,%DT,%X,%Y,DA347,DIQ2,DATEMOYR,FMSDOCNO,GECSDATA,LASTMONT,RCRJFAR1,RCRJFAR2,RCRJFBDR,RCRJFOIG,RCRJFSV,RCRJFTR,RCRJFWR,X,Y,ZTSK,RCNOHSIF
  1. ;
  1. S RCNOHSIF=$$NOHSIF() ; HSIF is disabed
  1. ;
  1. W !!,"This option will re-run the AR Data Collector, extracting data from"
  1. W !,"the AR database and sending the data to the National Database and FMS."
  1. W !,"It will also re-generate the Bad Debt Report and the OIG Extract."
  1. W !!,"This option will perform the following tasks:",!
  1. W !," 1. Re-send the data to the National Database. The data will only be"
  1. W !," re-sent if you answer YES to the prompt. The data will only be"
  1. W !," accepted in the NDB if the month-year has not been closed (in the NDB)."
  1. W !," 2. Re-send the data to FMS on the SV and WR documents. The data"
  1. W !," will only be re-sent if it has not been previously accepted by FMS."
  1. W !," 3. Re-send the OIG Extract. If the selected month is the end of the"
  1. W !," quarter (December, March, June, or September), the OIG Extract can"
  1. W !," be re-generated."
  1. ;
  1. ; do not allow dates in future to be selected
  1. ;S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
  1. I $E(DT,6,7)'>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
  1. I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$E($$LDATE^RCRJR(DT),1,5)_"00"
  1. S %DT(0)=-LASTMONT
  1. S %DT("A")="Retransmit AR Data Collector data for Month/Year: "
  1. S %DT="AEMP"
  1. W ! D ^%DT
  1. I Y<1 Q
  1. ;
  1. S (DATEMOYR,Y)=$E(Y,1,5)_"00" D DD^%DT
  1. ;
  1. ; try and find SV document to see if its accepted
  1. K GECSDATA
  1. D KEYLOOK^GECSSGET("SV-"_DATEMOYR,1)
  1. I $G(GECSDATA) D Q:'$G(GECSDATA)
  1. . W !!,"The SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
  1. . . W !,"The SV document has been ACCEPTED in FMS and will not be resent."
  1. . . S RCRJFSV=1
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
  1. . . W !,"The SV document has REJECTED and will be RETRANSMITTED."
  1. . W !,"The SV document has NOT been ACCEPTED in FMS."
  1. . S %=$$ASKTRANS I %<0 K GECSDATA Q
  1. . I %'=1 S RCRJFSV=1 ;do not send document
  1. ;
  1. ; try and find WR document to see if its accepted
  1. K GECSDATA
  1. D KEYLOOK^GECSSGET("WR-"_DATEMOYR,1)
  1. I $G(GECSDATA) D Q:'$G(GECSDATA)
  1. . W !!,"The WR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
  1. . . W !,"The WR document has been ACCEPTED in FMS and will not be resent."
  1. . . S RCRJFWR=1
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
  1. . . W !,"The WR document has REJECTED and will be RETRANSMITTED."
  1. . W !,"The WR document has NOT been ACCEPTED in FMS."
  1. . S %=$$ASKTRANS I %<0 K GECSDATA Q
  1. . I %'=1 S RCRJFWR=1 ;do not send document
  1. ;
  1. ; try and find the Bad Debt SV document to see if its accepted
  1. K GECSDATA
  1. D KEYLOOK^GECSSGET("SV-"_$E(DATEMOYR,1,5)_"01",1)
  1. I $G(GECSDATA) D Q:'$G(GECSDATA)
  1. . W !!,"The Bad Debt SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
  1. . . W !,"The Bad Debt SV document has been ACCEPTED in FMS and will not be resent."
  1. . . S RCRJFBDR=1
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
  1. . . W !,"The Bad Debt SV document has REJECTED and will be RETRANSMITTED."
  1. . W !,"The Bad Debt SV document has NOT been ACCEPTED in FMS."
  1. . S %=$$ASKTRANS I %<0 K GECSDATA Q
  1. . I %'=1 S RCRJFBDR=1 ;do not send document
  1. ;
  1. ; try and find TR document to see if its accepted
  1. K GECSDATA
  1. I 'RCNOHSIF D KEYLOOK^GECSSGET("TR-"_DATEMOYR,1)
  1. I $G(GECSDATA) D Q:'$G(GECSDATA)
  1. . W !!,"The TR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
  1. . . W !,"The TR document has been ACCEPTED in FMS and will not be resent."
  1. . . S RCRJFTR=1
  1. . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
  1. . . W !,"The TR document has REJECTED and will be RETRANSMITTED."
  1. . W !,"The TR document has NOT been ACCEPTED in FMS."
  1. . S %=$$ASKTRANS I %<0 K GECSDATA Q
  1. . I %'=1 S RCRJFTR=1 ;do not send document
  1. ;
  1. I RCNOHSIF S RCRJFTR=1 ;do not send TR if disabled
  1. ;
  1. ; ask to resend AR1 NDB data
  1. S %=$$ASKNDB("AR1") I %<0 Q
  1. I %'=1 S RCRJFAR1=1 ;do not send to ndb
  1. ;
  1. ; ask to resend AR2 NDB data
  1. S %=$$ASKNDB("AR2") I %<0 Q
  1. I %'=1 S RCRJFAR2=1 ;do not send to ndb
  1. ;
  1. ; ask to resend the OIG extract
  1. S RCRJFOIG=1 ; resend the OIG extract
  1. D I %<0 Q
  1. . S %=$$ASKOIG I %<0 Q
  1. . I %=1 S RCRJFOIG=0 ;re-send oig extract
  1. ;
  1. ;
  1. I $G(RCRJFAR1),$G(RCRJFAR2),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) W !!,"No reports have been selected for retransmission." Q
  1. ;
  1. W !!,"This option will retransmit the following monthly reports:"
  1. I '$G(RCRJFAR1) W !," AR1 to the NDB."
  1. I '$G(RCRJFAR2) W !," AR2 to the NDB."
  1. I '$G(RCRJFSV) W !," SV document to FMS."
  1. I '$G(RCRJFWR) W !," WR document to FMS."
  1. I '$G(RCRJFTR) W !," TR document to FMS."
  1. I '$G(RCRJFBDR) W !," rebuild the Bad Debt Report."
  1. I '$G(RCRJFOIG) W !," resend the OIG Extract."
  1. ;
  1. I $$ASKOKAY(DATEMOYR)=1 D
  1. . W !!,"This will be queued to run in the background. When it completes,"
  1. . W !,"a mail message will be sent to the mail group RC AR DATA COLLECTOR."
  1. . S ZTDESC="AR Data Collector",ZTRTN="DQ^RCRJRCO",ZTDTH=$H,ZTIO=""
  1. . S ZTSAVE("DATEMOYR")="",ZTSAVE("RCRJF*")="",ZTSAVE("ZTREQ")="@"
  1. . D ^%ZTLOAD
  1. . W !!,"Queued to run in task ",$G(ZTSK)
  1. Q
  1. ;
  1. ;
  1. DQ ; start collection of monthly data
  1. ; datemoyr is for the month and year to run collector (ex 2971000)
  1. ; rcrjfsv and rcrjfwr are flags to stop the sv and wr documents
  1. ; rcrjfbdr is a flag to stop the rebuild of the bad debt report
  1. N %,DATEBEG,DATEEND,PRCASITE,X
  1. ;
  1. I $$NOHSIF() S RCRJFTR=1 ; disable TR to FMS
  1. ; get last month
  1. I $G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DATEMOYR)
  1. I '$G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DT),DATEMOYR=$E(DATEEND,1,5)_"00"
  1. ;
  1. ;S DATEBEG=$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1
  1. S DATEBEG=$S(+$E(DATEEND,2,5)=309:$E(DATEEND,1,5)_"01",1:$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1)
  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
  1. ;S DATEEND=$$LDATE^RCRJR(DT)
  1. ;S DATEEND=$E(DATEMOYR,1,5)_DATEEND
  1. ;
  1. S PRCASITE=$$SITE^RCMSITE
  1. ;
  1. ; queue the AR2 data collector to run in the background
  1. I '$G(RCRJFAR2) D
  1. . S ZTDESC="AR2 Data Collector",ZTRTN="DQ^RCRJRCO2",ZTDTH=$H,ZTIO=""
  1. . S ZTSAVE("PRCASITE")="",ZTSAVE("DATEBEG")="",ZTSAVE("DATEEND")="",ZTSAVE("ZTREQ")="@"
  1. . D ^%ZTLOAD
  1. ;
  1. ; no point in running data collector, nothing being sent
  1. I $G(RCRJFAR1),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) Q
  1. ;
  1. ; run the AR1 data collector
  1. D START^RCRJRCOL(PRCASITE,DATEBEG,DATEEND)
  1. Q
  1. ;
  1. ;
  1. ASKNDB(REPORT) ; ask to resend to national database
  1. ; report = AR1 or AR2
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Do you want to resend the "_REPORT_" data to the National Database"
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ;
  1. ASKBDR() ; ask to rebuild the bad debt report
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Do you want to rebuild the Bad Debt Report"
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ;
  1. ASKOKAY(DATEMOYR) ; ask if its okay
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
  1. S Y=DATEMOYR D DD^%DT
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Are you SURE you want to regenerate the data for "_Y
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ;
  1. ASKTRANS() ; ask if its okay to retransmit document to FMS
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
  1. S Y=DATEMOYR D DD^%DT
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Do you want to regenerate and retransmit this document to FMS"
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ;
  1. ASKOIG() ; ask to resend to oig
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")=" Do you want to resend the data to the OIG"
  1. W ! D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. ;The Date when AAC is ready for Point Accounts:
  1. PAEFFDT() Q 3031001 ;10/1/2003
  1. ;
  1. ; The Data Collector cannot send 5287 Point Accounts before the Effective Date
  1. ; This function adjusts the fund depending on the current date
  1. ADJFUND(RCFUND) ;
  1. I DT'<$$PAEFFDT() Q RCFUND ; Do nothing after the effective date
  1. I $E(RCFUND,1,4)=5287 Q 5287 ; No point accounts before the effective date
  1. Q RCFUND
  1. ;
  1. ; The function returns 1 if MCCF-HSIF transfer is disabled
  1. NOHSIF() ;
  1. Q (DT'<$$PAEFFDT()) ; Disabled after the AAC is ready.