| 1 | IBOHDT ;ALB/EMG - REPORT OF CHARGES ON HOLD > 60 DAYS ;FEB 14 1997
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**70,95,142,347**;21-MAR-94;Build 24
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | MAIN ;
|
|---|
| 6 | N DIRUT,DTOUT,DUOUT,IBNUM,IBQUIT,POP,VA,ZTIO,Y S (IBQUIT,IBNUM)=0
|
|---|
| 7 | W !!
|
|---|
| 8 | S DIR(0)="NO",DIR("B")=60,DIR("A")="Enter number of days",DIR("A",1)="This report is used to follow-up on charges that have been on hold for an"
|
|---|
| 9 | S DIR("A",2)="extended period of time. Press return to print a list of charges on hold",DIR("A",3)="for longer than 60 days. You may limit your search to older charges"
|
|---|
| 10 | S DIR("A",4)="by typing a higher number. (For example, type 80 to see charges on hold",DIR("A",5)="for longer than 80 days.)",DIR("A",6)=""
|
|---|
| 11 | D ^DIR K DIR S IBNUM=+Y Q:$D(DIRUT)
|
|---|
| 12 | QUEUED ; entry point if queued
|
|---|
| 13 | ;***
|
|---|
| 14 | K ^TMP($J)
|
|---|
| 15 | D:'$G(IBQUIT) DEVICE D:'$G(IBQUIT) CHRGS,REPORT^IBOHDT1
|
|---|
| 16 | D EXIT
|
|---|
| 17 | ;***
|
|---|
| 18 | Q
|
|---|
| 19 | EXIT ;
|
|---|
| 20 | K ^TMP($J)
|
|---|
| 21 | K IBRDT,IBRF,IBRX,IBRXN
|
|---|
| 22 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 23 | D ^%ZISC
|
|---|
| 24 | Q
|
|---|
| 25 | DEVICE ;
|
|---|
| 26 | I $D(ZTQUEUED) Q
|
|---|
| 27 | W !!,*7,"*** Margin width of this output is 132 ***"
|
|---|
| 28 | W !,"*** This output should be queued ***"
|
|---|
| 29 | S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 Q
|
|---|
| 30 | I $D(IO("Q")) S ZTRTN="QUEUED^IBOHDT",ZTIO=ION,ZTDESC="HELD CHARGES REPORT",ZTSAVE("IB*")="" D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") D HOME^%ZIS K ZTSK S IBQUIT=1 Q
|
|---|
| 31 | U IO
|
|---|
| 32 | Q
|
|---|
| 33 | ; indexes records that should be included in report
|
|---|
| 34 | ;
|
|---|
| 35 | CHRGS ; charges on hold
|
|---|
| 36 | N DFN,IBDT,IBN,IBNAME,IBND,IBTYPE,X1,X2
|
|---|
| 37 | S X1=DT,X2=(-IBNUM) D C^%DTC S IBTO=X
|
|---|
| 38 | S DFN=0 F S DFN=$O(^IB("AHDT",DFN)) Q:'DFN S IBDT=0 F S IBDT=$O(^IB("AHDT",DFN,8,IBDT)) Q:'IBDT!(IBDT>IBTO) S IBN=0 F S IBN=$O(^IB("AHDT",DFN,8,IBDT,IBN)) Q:IBN="" D
|
|---|
| 39 | .S IBND=$G(^IB(IBN,0)) Q:'IBND
|
|---|
| 40 | .S DFN=$P(IBND,"^",2) D ;fetch patient name
|
|---|
| 41 | ..N VAERR,VADM D DEM^VADPT I VAERR K VADM
|
|---|
| 42 | ..S IBNAME=$G(VADM(1))
|
|---|
| 43 | ..Q
|
|---|
| 44 | .S IBTYPE=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^"),IBATYPE=$S(IBTYPE["OPT":"O",IBTYPE["PSO":"RX",1:"I")
|
|---|
| 45 | .S ^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN)=""
|
|---|
| 46 | .D BILLS
|
|---|
| 47 | Q
|
|---|
| 48 | PAT ; patient name
|
|---|
| 49 | N VAERR,VADM D DEM^VADPT I VAERR K VADM
|
|---|
| 50 | S IBNAME=$G(VADM(1)) S:IBNAME="" IBNAME=" "
|
|---|
| 51 | Q
|
|---|
| 52 | BILLS ; find bills for charges on hold
|
|---|
| 53 | N IBFR,IBT,IBATYPE,IBTO
|
|---|
| 54 | S IBATYPE=$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["OPT":"O",$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["PSO":"RX",1:"I")
|
|---|
| 55 | S IBFR=$P(IBND,"^",14),IBTO=$P(IBND,"^",15)
|
|---|
| 56 | I IBATYPE="I" D INP
|
|---|
| 57 | I IBATYPE="O" D OPT
|
|---|
| 58 | E D RX,OPT
|
|---|
| 59 | Q
|
|---|
| 60 | INP ; inpatient bills
|
|---|
| 61 | N IBEV,IBBILL,IBT,X,IBEND,IBOK
|
|---|
| 62 | S IBEV=$P(IBND,"^",16) Q:'IBEV ; parent event
|
|---|
| 63 | S IBEV=($P($G(^IB(IBEV,0)),"^",17)\1) Q:'IBEV ; date of parent event
|
|---|
| 64 | S X1=IBEV,X2=1 D C^%DTC S IBEND=X
|
|---|
| 65 | S IBT=(IBEV-.0001) F S IBT=$O(^DGCR(399,"D",IBT)) Q:'IBT!(IBT'<IBEND) S IBBILL=0 F S IBBILL=$O(^DGCR(399,"D",IBT,IBBILL)) Q:IBBILL="" D
|
|---|
| 66 | .D INPTCK
|
|---|
| 67 | .I IBOK S ^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN,IBBILL)=""
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | INPTCK ; does bill belong to charge? returns IBOK=0 if no
|
|---|
| 71 | N IBBILL0,IBBILLU
|
|---|
| 72 | S IBBILL0=$G(^DGCR(399,IBBILL,0)),IBBILLU=$G(^("U"))
|
|---|
| 73 | S IBOK=1
|
|---|
| 74 | CK1 ; for same patient?
|
|---|
| 75 | I DFN=$P(IBBILL0,"^",2)
|
|---|
| 76 | S IBOK=$T
|
|---|
| 77 | Q:'IBOK
|
|---|
| 78 | CK2 ; same type- inp or opt?
|
|---|
| 79 | N B S B=$S(+$P(IBBILL0,"^",5)<3:"I",1:"O")
|
|---|
| 80 | I B=IBATYPE
|
|---|
| 81 | S IBOK=$T
|
|---|
| 82 | Q:'IBOK
|
|---|
| 83 | CK3 ; overlap in date range?
|
|---|
| 84 | N F,T
|
|---|
| 85 | S F=+IBBILLU,T=$P(IBBILLU,"^",2)
|
|---|
| 86 | I (IBTO<F)!(IBFR>T)
|
|---|
| 87 | S IBOK='$T
|
|---|
| 88 | Q:'IBOK
|
|---|
| 89 | CK4 ; insurance bill?
|
|---|
| 90 | I $P(IBBILL0,"^",11)="i"
|
|---|
| 91 | S IBOK=$T
|
|---|
| 92 | Q
|
|---|
| 93 | OPT ; outpatient bills
|
|---|
| 94 | N X,IBV,IBBILL,IBOK,IBBILL0
|
|---|
| 95 | S IBV=(IBFR\1)-.0001 F S IBV=$O(^DGCR(399,"AOPV",DFN,IBV)) Q:'IBV!(IBV>IBTO) S IBBILL=0 D
|
|---|
| 96 | .F S IBBILL=$O(^DGCR(399,"AOPV",DFN,IBV,IBBILL)) Q:('IBBILL) D
|
|---|
| 97 | ..Q:$D(^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN,IBBILL))
|
|---|
| 98 | ..S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 Q:'IBOK
|
|---|
| 99 | ..S ^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN,IBBILL)=""
|
|---|
| 100 | Q
|
|---|
| 101 | RX ; rx refill bills
|
|---|
| 102 | S (IBRX,IBRXN,IBRF,IBRDT)=0 N IENS
|
|---|
| 103 | I $P(IBND,"^",4)'["52:" Q
|
|---|
| 104 | ;
|
|---|
| 105 | S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
|
|---|
| 106 | ;
|
|---|
| 107 | I +IBRF>0 S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
|
|---|
| 108 | I +IBRF=0 S IBRDT=$$FILE^IBRXUTL(+IBRXN,22)
|
|---|
| 109 | ;
|
|---|
| 110 | Q:(IBRX="")!('IBRDT)
|
|---|
| 111 | N X,IBBILL,IBBILL0,IBFILL,IBFILL0,IBOK S IBBILL=0
|
|---|
| 112 | S IBFILL=0 F S IBFILL=$O(^IBA(362.4,"B",IBRX,IBFILL)) Q:IBFILL="" D
|
|---|
| 113 | .S IBFILL0=$G(^IBA(362.4,IBFILL,0)) I $P(IBFILL0,"^",3)'=IBRDT Q
|
|---|
| 114 | .S IBBILL=+$P(IBFILL0,"^",2) I 'IBBILL Q
|
|---|
| 115 | .S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 I 'IBOK Q
|
|---|
| 116 | .S ^TMP($J,"HOLD",IBNAME,DFN,IBATYPE,IBN,IBBILL)=""
|
|---|
| 117 | Q
|
|---|
