source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOHDT.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1IBOHDT ;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 ;
5MAIN ;
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)
12QUEUED ; 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
19EXIT ;
20 K ^TMP($J)
21 K IBRDT,IBRF,IBRX,IBRXN
22 I $D(ZTQUEUED) S ZTREQ="@" Q
23 D ^%ZISC
24 Q
25DEVICE ;
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 ;
35CHRGS ; 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
48PAT ; patient name
49 N VAERR,VADM D DEM^VADPT I VAERR K VADM
50 S IBNAME=$G(VADM(1)) S:IBNAME="" IBNAME=" "
51 Q
52BILLS ; 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
60INP ; 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 ;
70INPTCK ; 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
74CK1 ; for same patient?
75 I DFN=$P(IBBILL0,"^",2)
76 S IBOK=$T
77 Q:'IBOK
78CK2 ; 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
83CK3 ; 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
89CK4 ; insurance bill?
90 I $P(IBBILL0,"^",11)="i"
91 S IBOK=$T
92 Q
93OPT ; 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
101RX ; 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
Note: See TracBrowser for help on using the repository browser.