| [613] | 1 | IBOTR2 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - COMPILATION ; 5-JUN-91
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**21,42,52,80,100,118,128**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | ;MAP TO DGCROTR2
|
|---|
| 5 | ;
|
|---|
| 6 | ;***
|
|---|
| 7 | ;S XRTL=$ZU(0),XRTN="IBOTR-2" D T0^%ZOSV ;start rt clock
|
|---|
| 8 | ;
|
|---|
| 9 | I $G(IBXTRACT) D E^IBJDE(8,1) ; Change extract status.
|
|---|
| 10 | ;
|
|---|
| 11 | K ^TMP($J) S IBQUIT=0
|
|---|
| 12 | S IBDA="" F S IBDA=$O(^DGCR(399,"AD",IBRT,IBDA)) Q:'IBDA D Q:IBQUIT
|
|---|
| 13 | .D COMP I IBDA#100=0 S IBQUIT=$$STOP^IBOUTL("Trend Report")
|
|---|
| 14 | ;
|
|---|
| 15 | ; - Write the output report.
|
|---|
| 16 | I 'IBQUIT D
|
|---|
| 17 | .I 'IBSDIV D:"OP"[IBSORT SORT D EN^IBOTR3(0) Q
|
|---|
| 18 | .S IBDIV=0 F S IBDIV=$S('VAUTD:$O(VAUTD(IBDIV)),1:$O(^DG(40.8,IBDIV))) Q:'IBDIV D:"OP"[IBSORT SORT D EN^IBOTR3(IBDIV) Q:IBQUIT
|
|---|
| 19 | ;
|
|---|
| 20 | ;***
|
|---|
| 21 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOTR2" D T1^%ZOSV ;stop rt clock
|
|---|
| 22 | ENQ I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 23 | K IB,IBAO,IBAP,IBCNT,IBDA,DFN,IBBC,DIC,DA,DR,DIQ,IBDP,IBDBC,IBSCF,IBSCT
|
|---|
| 24 | K IBCFL,IBDIV,IBQUIT,IBEVT,^TMP($J) D ^%ZISC
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | COMP ; - Compile Bill-Accounts Receivable records for report.
|
|---|
| 28 | S IBD=$G(^DGCR(399,IBDA,0)) I IBD="" Q
|
|---|
| 29 | ;
|
|---|
| 30 | ; - Get division, if necessary.
|
|---|
| 31 | I 'IBSDIV S IBDIV=0
|
|---|
| 32 | E S IBDIV=$$DIV^IBJDF2(IBDA) I 'IBDIV S IBDIV=+$$PRIM^VASITE()
|
|---|
| 33 | I IBSDIV,'VAUTD,'$D(VAUTD(IBDIV)) Q ; Not a selected division.
|
|---|
| 34 | ;
|
|---|
| 35 | ; - Exclude receivables referred to Regional Counsel, if necessary.
|
|---|
| 36 | I 'IBINRC,$P($G(^PRCA(430,IBDA,6)),U,4) Q
|
|---|
| 37 | ;
|
|---|
| 38 | S IBBN=$P(IBD,U),DFN=+$P(IBD,U,2),IBEVT=+$P(IBD,U,3),IBBC=$P(IBD,U,5)
|
|---|
| 39 | S:IBBN="" IBBN="NULL" Q:IBBRT="O"&("12"[IBBC) Q:IBBRT="I"&("34"[IBBC)
|
|---|
| 40 | S IBDBC=$$CLO^PRCAFN(IBDA) Q:IBARST="O"&(IBDBC>-2)!(IBARST="C"&(IBDBC<-1))
|
|---|
| 41 | I IBDBC>0 S IBBN=IBBN_" *"
|
|---|
| 42 | E S IBD=$P($$STA^PRCAFN(IBDA),U,2),IBDBC=$S($L(IBD)>8:$E(IBD,1,8),1:IBD)
|
|---|
| 43 | I $D(IBBRN),IBBRN="S" S IBBRTY=$S("12"[IBBC:"I",1:"O")
|
|---|
| 44 | ;
|
|---|
| 45 | ; - Perform edits for insurance company.
|
|---|
| 46 | S IBD=$P($G(^DGCR(399,IBDA,"MP")),U),IBINS=$P($G(^DIC(36,+IBD,0)),U)
|
|---|
| 47 | I $G(IBICPT) Q:'$D(IBICPT(+IBD)) G CANC
|
|---|
| 48 | I IBICF'="@",IBD="" Q
|
|---|
| 49 | I $D(IBIC) Q:IBIC="ALL"&(IBD="") Q:IBIC="NULL"&(IBD]"")
|
|---|
| 50 | I IBINS="" S IBINS="UNKNOWN" G CANC
|
|---|
| 51 | I $G(IBIC)="ALL" G CANC
|
|---|
| 52 | I IBICF="@",IBICL="zzzzz" G CANC
|
|---|
| 53 | I IBICF]IBINS!(IBINS]IBICL) Q
|
|---|
| 54 | ;
|
|---|
| 55 | CANC ; - Keep cancelled bills if CANCEL BILL? field was selected or answer
|
|---|
| 56 | ; to 'Do you want to include cancelled receivables?' prompt was YES.
|
|---|
| 57 | S IBCFL=0,IBINS=IBINS_"@@"_IBD Q:'$D(^DGCR(399,IBDA,"S")) S IBD=^("S")
|
|---|
| 58 | S IBCNC=0 I "^26^39^"[(U_$P($G(^PRCA(430,IBDA,0)),U,8)_U) S IBCNC=1
|
|---|
| 59 | I $G(IBCANC),($P(IBD,U,16)!(IBCNC)) S IBCFL=1 G PTDE ; Add canc. bill.
|
|---|
| 60 | I $G(IBAF)'=16 Q:$P(IBD,U,16)!(IBCNC) ; Bill has been cancelled.
|
|---|
| 61 | ;
|
|---|
| 62 | PTDE ; - Perform Printed/Treatment date edits.
|
|---|
| 63 | S IBDP=$P(IBD,U,12)
|
|---|
| 64 | I IBDF=1 Q:IBDP<IBBDT!(IBDP>IBEDT) ; Date printed is out of range.
|
|---|
| 65 | S IBD=$G(^DGCR(399,IBDA,"U")),IBSCF=$P(IBD,U),IBSCT=$P(IBD,U,2)
|
|---|
| 66 | I IBDF=2 Q:IBSCT<IBBDT!(IBSCF>IBEDT) ; Treatment dates out of range.
|
|---|
| 67 | I '$D(IBAF) G BUILD
|
|---|
| 68 | ;
|
|---|
| 69 | ; - Find the selected field value and compare to selection parameters.
|
|---|
| 70 | K IB S DIC=399,DA=IBDA,DR=IBAF,DIQ="IB" S:IBAFD DIQ(0)="I"
|
|---|
| 71 | D EN^DIQ1 K DIQ S:IBAFD IB(399,IBDA,IBAF)=IB(399,IBDA,IBAF,"I")
|
|---|
| 72 | S IB=$G(IB(399,IBDA,IBAF)) I IB="",IBAFF'="@" Q
|
|---|
| 73 | I $D(IBAFZ) Q:IBAFZ="ALL"&(IB="") Q:IBAFZ="NULL"&(IB]"")
|
|---|
| 74 | I IB=""!($G(IBAFZ)="ALL") G BUILD
|
|---|
| 75 | I IBAFF="@",IBAFL="" G BUILD
|
|---|
| 76 | I +IBAFF=IBAFF,+IBAFL=IBAFL Q:IB<IBAFF!(IB>IBAFL)
|
|---|
| 77 | E Q:IBAFF]IB!(IB]IBAFL)
|
|---|
| 78 | ;
|
|---|
| 79 | BUILD ; - Retrieve A/R data and build sort global.
|
|---|
| 80 | S IBAO=$$ORI^PRCAFN(IBDA) S:IBAO<0 IBAO=0
|
|---|
| 81 | S IBAP=$$TPR^PRCAFN(IBDA) S:IBAP<0 IBAP=0
|
|---|
| 82 | S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS,$$NAMAGE(DFN,IBEVT)_"@@"_IBBN)=U_IBSCF_U_IBSCT_U_IBDP_U_IBDBC_U_IBAO_U_IBAP_U_IBCFL
|
|---|
| 83 | I "OP"[IBSORT D
|
|---|
| 84 | .S ^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS)=$G(^TMP($J,"IBOTR",IBDIV,IBBRTY,IBINS))+$S(IBSORT="O":(IBAO-IBAP),1:IBAP)
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | SORT ; - Create sort global based on amount owed/amount paid, if necessary.
|
|---|
| 88 | I 'IBSDIV S IBDIV=0
|
|---|
| 89 | S IBX="" F S IBX=$O(^TMP($J,"IBOTR",IBDIV,IBX)) Q:IBX="" D
|
|---|
| 90 | .S IBINS="" F S IBINS=$O(^TMP($J,"IBOTR",IBDIV,IBX,IBINS)) Q:IBINS="" S IBXX=^(IBINS),^TMP($J,"IBOTRS",IBDIV,IBX,-IBXX,IBINS)=""
|
|---|
| 91 | K IBX,IBXX
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | NAMAGE(DFN,EVT) ; - Return patient name and age.
|
|---|
| 95 | ; Input: DFN = Pointer to patient in file #2
|
|---|
| 96 | ; EVT = Event Date of claim
|
|---|
| 97 | ; Output: Patient name (1st 18 chars.)_"("_Age_")"
|
|---|
| 98 | N DPT0,X,X1,X2
|
|---|
| 99 | S DPT0=$G(^DPT(DFN,0)),X2=$P(DPT0,U,3)
|
|---|
| 100 | I 'X2 S X="UNK"
|
|---|
| 101 | E S X1=EVT S:'X1 X1=DT D ^%DTC S X=X\365.25
|
|---|
| 102 | Q $E($P(DPT0,U),1,18)_" ("_X_")"
|
|---|
