| 1 | RCRJRCO ;WISC/RFJ-control collection of monthly data ;1 Nov 97
|
|---|
| 2 | ;;4.5;Accounts Receivable;**96,106,101,103,147,156,169,170,174,191,203,239**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ; called by menu option to regenerate monthly data
|
|---|
| 5 | N %,%DT,%X,%Y,DA347,DIQ2,DATEMOYR,FMSDOCNO,GECSDATA,LASTMONT,RCRJFAR1,RCRJFAR2,RCRJFBDR,RCRJFOIG,RCRJFSV,RCRJFTR,RCRJFWR,X,Y,ZTSK,RCNOHSIF
|
|---|
| 6 | ;
|
|---|
| 7 | S RCNOHSIF=$$NOHSIF() ; HSIF is disabed
|
|---|
| 8 | ;
|
|---|
| 9 | W !!,"This option will re-run the AR Data Collector, extracting data from"
|
|---|
| 10 | W !,"the AR database and sending the data to the National Database and FMS."
|
|---|
| 11 | W !,"It will also re-generate the Bad Debt Report and the OIG Extract."
|
|---|
| 12 | W !!,"This option will perform the following tasks:",!
|
|---|
| 13 | W !," 1. Re-send the data to the National Database. The data will only be"
|
|---|
| 14 | W !," re-sent if you answer YES to the prompt. The data will only be"
|
|---|
| 15 | W !," accepted in the NDB if the month-year has not been closed (in the NDB)."
|
|---|
| 16 | W !," 2. Re-send the data to FMS on the SV and WR documents. The data"
|
|---|
| 17 | W !," will only be re-sent if it has not been previously accepted by FMS."
|
|---|
| 18 | W !," 3. Re-send the OIG Extract. If the selected month is the end of the"
|
|---|
| 19 | W !," quarter (December, March, June, or September), the OIG Extract can"
|
|---|
| 20 | W !," be re-generated."
|
|---|
| 21 | ;
|
|---|
| 22 | ; do not allow dates in future to be selected
|
|---|
| 23 | ;S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
|
|---|
| 24 | I $E(DT,6,7)'>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$$PREVMONT^RCRJRBD(DT)
|
|---|
| 25 | I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S (LASTMONT,DATEMOYR)=$E($$LDATE^RCRJR(DT),1,5)_"00"
|
|---|
| 26 | S %DT(0)=-LASTMONT
|
|---|
| 27 | S %DT("A")="Retransmit AR Data Collector data for Month/Year: "
|
|---|
| 28 | S %DT="AEMP"
|
|---|
| 29 | W ! D ^%DT
|
|---|
| 30 | I Y<1 Q
|
|---|
| 31 | ;
|
|---|
| 32 | S (DATEMOYR,Y)=$E(Y,1,5)_"00" D DD^%DT
|
|---|
| 33 | ;
|
|---|
| 34 | ; try and find SV document to see if its accepted
|
|---|
| 35 | K GECSDATA
|
|---|
| 36 | D KEYLOOK^GECSSGET("SV-"_DATEMOYR,1)
|
|---|
| 37 | I $G(GECSDATA) D Q:'$G(GECSDATA)
|
|---|
| 38 | . W !!,"The SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
|
|---|
| 39 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
|
|---|
| 40 | . . W !,"The SV document has been ACCEPTED in FMS and will not be resent."
|
|---|
| 41 | . . S RCRJFSV=1
|
|---|
| 42 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
|
|---|
| 43 | . . W !,"The SV document has REJECTED and will be RETRANSMITTED."
|
|---|
| 44 | . W !,"The SV document has NOT been ACCEPTED in FMS."
|
|---|
| 45 | . S %=$$ASKTRANS I %<0 K GECSDATA Q
|
|---|
| 46 | . I %'=1 S RCRJFSV=1 ;do not send document
|
|---|
| 47 | ;
|
|---|
| 48 | ; try and find WR document to see if its accepted
|
|---|
| 49 | K GECSDATA
|
|---|
| 50 | D KEYLOOK^GECSSGET("WR-"_DATEMOYR,1)
|
|---|
| 51 | I $G(GECSDATA) D Q:'$G(GECSDATA)
|
|---|
| 52 | . W !!,"The WR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
|
|---|
| 53 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
|
|---|
| 54 | . . W !,"The WR document has been ACCEPTED in FMS and will not be resent."
|
|---|
| 55 | . . S RCRJFWR=1
|
|---|
| 56 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
|
|---|
| 57 | . . W !,"The WR document has REJECTED and will be RETRANSMITTED."
|
|---|
| 58 | . W !,"The WR document has NOT been ACCEPTED in FMS."
|
|---|
| 59 | . S %=$$ASKTRANS I %<0 K GECSDATA Q
|
|---|
| 60 | . I %'=1 S RCRJFWR=1 ;do not send document
|
|---|
| 61 | ;
|
|---|
| 62 | ; try and find the Bad Debt SV document to see if its accepted
|
|---|
| 63 | K GECSDATA
|
|---|
| 64 | D KEYLOOK^GECSSGET("SV-"_$E(DATEMOYR,1,5)_"01",1)
|
|---|
| 65 | I $G(GECSDATA) D Q:'$G(GECSDATA)
|
|---|
| 66 | . W !!,"The Bad Debt SV document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
|
|---|
| 67 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
|
|---|
| 68 | . . W !,"The Bad Debt SV document has been ACCEPTED in FMS and will not be resent."
|
|---|
| 69 | . . S RCRJFBDR=1
|
|---|
| 70 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
|
|---|
| 71 | . . W !,"The Bad Debt SV document has REJECTED and will be RETRANSMITTED."
|
|---|
| 72 | . W !,"The Bad Debt SV document has NOT been ACCEPTED in FMS."
|
|---|
| 73 | . S %=$$ASKTRANS I %<0 K GECSDATA Q
|
|---|
| 74 | . I %'=1 S RCRJFBDR=1 ;do not send document
|
|---|
| 75 | ;
|
|---|
| 76 | ; try and find TR document to see if its accepted
|
|---|
| 77 | K GECSDATA
|
|---|
| 78 | I 'RCNOHSIF D KEYLOOK^GECSSGET("TR-"_DATEMOYR,1)
|
|---|
| 79 | I $G(GECSDATA) D Q:'$G(GECSDATA)
|
|---|
| 80 | . W !!,"The TR document has been transmitted to fms, document number: "_GECSDATA("2100.1",GECSDATA,".01","E")
|
|---|
| 81 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="A" D Q
|
|---|
| 82 | . . W !,"The TR document has been ACCEPTED in FMS and will not be resent."
|
|---|
| 83 | . . S RCRJFTR=1
|
|---|
| 84 | . I $E($G(GECSDATA(2100.1,GECSDATA,3,"E")))="R" D Q
|
|---|
| 85 | . . W !,"The TR document has REJECTED and will be RETRANSMITTED."
|
|---|
| 86 | . W !,"The TR document has NOT been ACCEPTED in FMS."
|
|---|
| 87 | . S %=$$ASKTRANS I %<0 K GECSDATA Q
|
|---|
| 88 | . I %'=1 S RCRJFTR=1 ;do not send document
|
|---|
| 89 | ;
|
|---|
| 90 | I RCNOHSIF S RCRJFTR=1 ;do not send TR if disabled
|
|---|
| 91 | ;
|
|---|
| 92 | ; ask to resend AR1 NDB data
|
|---|
| 93 | S %=$$ASKNDB("AR1") I %<0 Q
|
|---|
| 94 | I %'=1 S RCRJFAR1=1 ;do not send to ndb
|
|---|
| 95 | ;
|
|---|
| 96 | ; ask to resend AR2 NDB data
|
|---|
| 97 | S %=$$ASKNDB("AR2") I %<0 Q
|
|---|
| 98 | I %'=1 S RCRJFAR2=1 ;do not send to ndb
|
|---|
| 99 | ;
|
|---|
| 100 | ; ask to resend the OIG extract
|
|---|
| 101 | S RCRJFOIG=1 ; resend the OIG extract
|
|---|
| 102 | D I %<0 Q
|
|---|
| 103 | . S %=$$ASKOIG I %<0 Q
|
|---|
| 104 | . I %=1 S RCRJFOIG=0 ;re-send oig extract
|
|---|
| 105 | ;
|
|---|
| 106 | ;
|
|---|
| 107 | I $G(RCRJFAR1),$G(RCRJFAR2),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) W !!,"No reports have been selected for retransmission." Q
|
|---|
| 108 | ;
|
|---|
| 109 | W !!,"This option will retransmit the following monthly reports:"
|
|---|
| 110 | I '$G(RCRJFAR1) W !," AR1 to the NDB."
|
|---|
| 111 | I '$G(RCRJFAR2) W !," AR2 to the NDB."
|
|---|
| 112 | I '$G(RCRJFSV) W !," SV document to FMS."
|
|---|
| 113 | I '$G(RCRJFWR) W !," WR document to FMS."
|
|---|
| 114 | I '$G(RCRJFTR) W !," TR document to FMS."
|
|---|
| 115 | I '$G(RCRJFBDR) W !," rebuild the Bad Debt Report."
|
|---|
| 116 | I '$G(RCRJFOIG) W !," resend the OIG Extract."
|
|---|
| 117 | ;
|
|---|
| 118 | I $$ASKOKAY(DATEMOYR)=1 D
|
|---|
| 119 | . W !!,"This will be queued to run in the background. When it completes,"
|
|---|
| 120 | . W !,"a mail message will be sent to the mail group RC AR DATA COLLECTOR."
|
|---|
| 121 | . S ZTDESC="AR Data Collector",ZTRTN="DQ^RCRJRCO",ZTDTH=$H,ZTIO=""
|
|---|
| 122 | . S ZTSAVE("DATEMOYR")="",ZTSAVE("RCRJF*")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 123 | . D ^%ZTLOAD
|
|---|
| 124 | . W !!,"Queued to run in task ",$G(ZTSK)
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | ;
|
|---|
| 128 | DQ ; start collection of monthly data
|
|---|
| 129 | ; datemoyr is for the month and year to run collector (ex 2971000)
|
|---|
| 130 | ; rcrjfsv and rcrjfwr are flags to stop the sv and wr documents
|
|---|
| 131 | ; rcrjfbdr is a flag to stop the rebuild of the bad debt report
|
|---|
| 132 | N %,DATEBEG,DATEEND,PRCASITE,X
|
|---|
| 133 | ;
|
|---|
| 134 | I $$NOHSIF() S RCRJFTR=1 ; disable TR to FMS
|
|---|
| 135 | ; get last month
|
|---|
| 136 | I $G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DATEMOYR)
|
|---|
| 137 | I '$G(DATEMOYR) S DATEEND=$$LDATE^RCRJR(DT),DATEMOYR=$E(DATEEND,1,5)_"00"
|
|---|
| 138 | ;
|
|---|
| 139 | ;S DATEBEG=$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1
|
|---|
| 140 | S DATEBEG=$S(+$E(DATEEND,2,5)=309:$E(DATEEND,1,5)_"01",1:$$LDATE^RCRJR($$PREVMONT^RCRJRBD(DATEEND))+1)
|
|---|
| 141 | ;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
|
|---|
| 142 | ;S DATEEND=$$LDATE^RCRJR(DT)
|
|---|
| 143 | ;S DATEEND=$E(DATEMOYR,1,5)_DATEEND
|
|---|
| 144 | ;
|
|---|
| 145 | S PRCASITE=$$SITE^RCMSITE
|
|---|
| 146 | ;
|
|---|
| 147 | ; queue the AR2 data collector to run in the background
|
|---|
| 148 | I '$G(RCRJFAR2) D
|
|---|
| 149 | . S ZTDESC="AR2 Data Collector",ZTRTN="DQ^RCRJRCO2",ZTDTH=$H,ZTIO=""
|
|---|
| 150 | . S ZTSAVE("PRCASITE")="",ZTSAVE("DATEBEG")="",ZTSAVE("DATEEND")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 151 | . D ^%ZTLOAD
|
|---|
| 152 | ;
|
|---|
| 153 | ; no point in running data collector, nothing being sent
|
|---|
| 154 | I $G(RCRJFAR1),$G(RCRJFSV),$G(RCRJFWR),$G(RCRJFTR),$G(RCRJFBDR),$G(RCRJFOIG) Q
|
|---|
| 155 | ;
|
|---|
| 156 | ; run the AR1 data collector
|
|---|
| 157 | D START^RCRJRCOL(PRCASITE,DATEBEG,DATEEND)
|
|---|
| 158 | Q
|
|---|
| 159 | ;
|
|---|
| 160 | ;
|
|---|
| 161 | ASKNDB(REPORT) ; ask to resend to national database
|
|---|
| 162 | ; report = AR1 or AR2
|
|---|
| 163 | ; 1 is yes, otherwise no
|
|---|
| 164 | N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 165 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 166 | S DIR("A")=" Do you want to resend the "_REPORT_" data to the National Database"
|
|---|
| 167 | W ! D ^DIR
|
|---|
| 168 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
|---|
| 169 | Q Y
|
|---|
| 170 | ;
|
|---|
| 171 | ;
|
|---|
| 172 | ASKBDR() ; ask to rebuild the bad debt report
|
|---|
| 173 | ; 1 is yes, otherwise no
|
|---|
| 174 | N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 175 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 176 | S DIR("A")=" Do you want to rebuild the Bad Debt Report"
|
|---|
| 177 | W ! D ^DIR
|
|---|
| 178 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
|---|
| 179 | Q Y
|
|---|
| 180 | ;
|
|---|
| 181 | ;
|
|---|
| 182 | ASKOKAY(DATEMOYR) ; ask if its okay
|
|---|
| 183 | ; 1 is yes, otherwise no
|
|---|
| 184 | N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 185 | S Y=DATEMOYR D DD^%DT
|
|---|
| 186 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 187 | S DIR("A")=" Are you SURE you want to regenerate the data for "_Y
|
|---|
| 188 | W ! D ^DIR
|
|---|
| 189 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
|---|
| 190 | Q Y
|
|---|
| 191 | ;
|
|---|
| 192 | ;
|
|---|
| 193 | ASKTRANS() ; ask if its okay to retransmit document to FMS
|
|---|
| 194 | ; 1 is yes, otherwise no
|
|---|
| 195 | N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 196 | S Y=DATEMOYR D DD^%DT
|
|---|
| 197 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 198 | S DIR("A")=" Do you want to regenerate and retransmit this document to FMS"
|
|---|
| 199 | D ^DIR
|
|---|
| 200 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
|---|
| 201 | Q Y
|
|---|
| 202 | ;
|
|---|
| 203 | ;
|
|---|
| 204 | ASKOIG() ; ask to resend to oig
|
|---|
| 205 | ; 1 is yes, otherwise no
|
|---|
| 206 | N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 207 | S DIR(0)="YO",DIR("B")="NO"
|
|---|
| 208 | S DIR("A")=" Do you want to resend the data to the OIG"
|
|---|
| 209 | W ! D ^DIR
|
|---|
| 210 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
|---|
| 211 | Q Y
|
|---|
| 212 | ;
|
|---|
| 213 | ;The Date when AAC is ready for Point Accounts:
|
|---|
| 214 | PAEFFDT() Q 3031001 ;10/1/2003
|
|---|
| 215 | ;
|
|---|
| 216 | ; The Data Collector cannot send 5287 Point Accounts before the Effective Date
|
|---|
| 217 | ; This function adjusts the fund depending on the current date
|
|---|
| 218 | ADJFUND(RCFUND) ;
|
|---|
| 219 | I DT'<$$PAEFFDT() Q RCFUND ; Do nothing after the effective date
|
|---|
| 220 | I $E(RCFUND,1,4)=5287 Q 5287 ; No point accounts before the effective date
|
|---|
| 221 | Q RCFUND
|
|---|
| 222 | ;
|
|---|
| 223 | ; The function returns 1 if MCCF-HSIF transfer is disabled
|
|---|
| 224 | NOHSIF() ;
|
|---|
| 225 | Q (DT'<$$PAEFFDT()) ; Disabled after the AAC is ready.
|
|---|
