| 1 | IBAECM3 ;WOIFO/SS-LTC PHASE 2 MONTHLY JOB PART 3 ; 20-FEB-02
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**176**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | MJ1ST ;entry for the first Monthly Calculation Process
|
|---|
| 6 | N IBMDS1
|
|---|
| 7 | ;------ variables
|
|---|
| 8 | N IBMJ1ST S IBMJ1ST="MJ1ST" ;to identify 1st MJ in IBAECU4
|
|---|
| 9 | N IBPRMNTH S IBPRMNTH=$$PREVMNTH^IBAECM1() ;last day of previous month
|
|---|
| 10 | N IBCLKAD1 ; variable to return back from PROCPAT info for clock adjustment
|
|---|
| 11 | N IBDFN,IBMNS,IBVAR
|
|---|
| 12 | N IBCLKIE1
|
|---|
| 13 | N IBCLKDAT ;clock data
|
|---|
| 14 | N IBSTRTD ;EFFECTIVE DATE
|
|---|
| 15 | S (IBMNS,IBMDS1)=""
|
|---|
| 16 | S IBSTRTD=$$BILDATE^IBAECN1()
|
|---|
| 17 | K ^TMP($J,"IBMJERR")
|
|---|
| 18 | K ^TMP($J,"IBMJINP")
|
|---|
| 19 | K ^TMP($J,"IBMJOUT")
|
|---|
| 20 | ;prepare arrays for months since the effective date
|
|---|
| 21 | D PRMONTHS(.IBMNS,IBPRMNTH)
|
|---|
| 22 | ;go thru all patients in #351.81
|
|---|
| 23 | S IBDFN1=0
|
|---|
| 24 | ;for each patient in file 351.81
|
|---|
| 25 | F S IBDFN1=$O(^IBA(351.81,"C",IBDFN1)) Q:+IBDFN1=0 D
|
|---|
| 26 | . S IBCLKIE1=0,IBERR=""
|
|---|
| 27 | . F S IBCLKIE1=+$O(^IBA(351.81,"C",IBDFN1,IBCLKIE1)) Q:+IBCLKIE1=0 D
|
|---|
| 28 | . . S IBCLKDAT=^IBA(351.81,IBCLKIE1,0)
|
|---|
| 29 | . . ; quit if STATUS'=OPEN
|
|---|
| 30 | . . Q:$P(IBCLKDAT,"^",5)'=1
|
|---|
| 31 | . . ; quit if CURRENT EVENTS DATE="" i.e. no LTC events happend
|
|---|
| 32 | . . ; this month for the patient
|
|---|
| 33 | . . Q:$P(IBCLKDAT,"^",7)=""
|
|---|
| 34 | . . ; quit if CURRENT EVENTS DATE>last day of "real-time" previous month -the veteran
|
|---|
| 35 | . . ; has been processed for all months in the past
|
|---|
| 36 | . . Q:$P(IBCLKDAT,"^",7)>IBPRMNTH
|
|---|
| 37 | . . ; if error save it in ^TMP for further e-mail
|
|---|
| 38 | . . S IBCLKAD1=""
|
|---|
| 39 | . . ;process the patient
|
|---|
| 40 | . . S IBVAR=0
|
|---|
| 41 | . . F S IBVAR=$O(IBMNS(IBVAR)) Q:+IBVAR=0 D
|
|---|
| 42 | . . . Q:$$CHKXTMP(IBDFN1,IBVAR) ;check if it was a crush and the month has been already processed
|
|---|
| 43 | . . . M IBMDS1=IBMNS(IBVAR) ;set month to process
|
|---|
| 44 | . . . S IBMDS1=$E(IBMDS1(1),6,7)
|
|---|
| 45 | . . . D CHNGEVEN^IBAECU4(IBCLKIE1,IBDFN1,IBMDS1(0)) ;set CURRENT EVENT DATE to a date of the MONTH (say,1st day)
|
|---|
| 46 | . . . I $$PROCPAT^IBAECM2(.IBMDS1,IBDFN1,IBSTRTD,IBCLKIE1)=-1 D ;perform calcualtion
|
|---|
| 47 | . . . . D ERRLOG^IBAECU5(+$G(IBDFN1),+$G(IBCLKIE1),"Charge","Error with LTC clock creation occured during calculation, no proper charges have been created") Q
|
|---|
| 48 | . . . D UPDXTMP(IBDFN1,IBVAR) ;mark the month as done
|
|---|
| 49 | . . D DELXTMP(IBDFN1)
|
|---|
| 50 | ;send all errors to user group
|
|---|
| 51 | D SENDERR^IBAECU5 ;send all errors
|
|---|
| 52 | ;if we reach this place that means that we processed everybody
|
|---|
| 53 | ;and we stamp the date into IB SITE PARAMETERS
|
|---|
| 54 | S $P(^IBE(350.9,1,0),"^",16)=$$TODAY^IBAECN1()
|
|---|
| 55 | ;if Nightly Job founds that date $P(^IBE(350.9,1,0),"^",16)
|
|---|
| 56 | ;is less that begining of current month than NJ runs MJ again and MJ will
|
|---|
| 57 | ;process a rest patients
|
|---|
| 58 | D KILLXTMP ;delete ^XTMP
|
|---|
| 59 | Q
|
|---|
| 60 | ;IBALLM - Array with month info
|
|---|
| 61 | ; IBALLM (0)-first day of the month
|
|---|
| 62 | ; IBALLM (1)-last day of the month
|
|---|
| 63 | ; IBALLM (2)-yyymm in Fileman format (like 30201 - for Jan 2002)
|
|---|
| 64 | ;IBPRMNTH -Last day of the last mont
|
|---|
| 65 | PRMONTHS(IBALLM,IBPRMNTH) ;prepare months
|
|---|
| 66 | S IBALLM=""
|
|---|
| 67 | N X,IB176YM,IB176TMP
|
|---|
| 68 | S IB176YM=$E($$BILDATE^IBAECN1(),1,5)
|
|---|
| 69 | F Q:IB176YM>$E(IBPRMNTH,1,5) D
|
|---|
| 70 | . S X=IB176YM_"01"
|
|---|
| 71 | . S IBALLM(IB176YM,1)=$$LASTDT^IBAECU(X)
|
|---|
| 72 | . S IBALLM(IB176YM,2)=$E(IBALLM(IB176YM,1),1,5)
|
|---|
| 73 | . S IBALLM(IB176YM,0)=IBALLM(IB176YM,2)_"01",IBALLM=$E(IBALLM(IB176YM,1),6,7)
|
|---|
| 74 | . I +$E(IB176YM,4,5)=12 S IB176YM=$E(IB176YM,1,3)+1,IB176YM=IB176YM_"01" Q
|
|---|
| 75 | . S IB176YM=IB176YM+1
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | KILLXTMP ;
|
|---|
| 79 | K ^XTMP("IBAEC-P176")
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | ;IBDFN - ien of #2
|
|---|
| 83 | ;IBYM - year_month in yyymm format
|
|---|
| 84 | CHKXTMP(IBDFN,IBYM) ;check if ^XTMP for the patient and month is exist
|
|---|
| 85 | Q $D(^XTMP("IBAEC-P176",IBDFN,IBYM))>0
|
|---|
| 86 | ;
|
|---|
| 87 | ;IBDFN - ien of #2
|
|---|
| 88 | ;IBYM - year_month in yyymm format
|
|---|
| 89 | UPDXTMP(IBDFN,IBYM) ;update XTMP with new info
|
|---|
| 90 | N IBDT S IBDT=$$TODAY^IBAECN1()
|
|---|
| 91 | S ^XTMP("IBAEC-P176",0)=$$CHNGDATE^IBAECU4(IBDT,30)_"^"_IBDT_"^1st LTC copay calculation"
|
|---|
| 92 | S ^XTMP("IBAEC-P176",+IBDFN,IBYM)=""
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | ;IBDFN - ien of #2
|
|---|
| 96 | DELXTMP(IBDFN) ;Kills ^XTMP node for the patient.
|
|---|
| 97 | K ^XTMP("IBAEC-P176",+IBDFN)
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
