close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOHPT1.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
1IBOHPT1 ;ALB/EMG - REPORT OF ON HOLD CHARGES FOR A PATIENT ;JULY 22 1997
2 ;;2.0;INTEGRATED BILLING;**70,95,142,199,347**;21-MAR-94;Build 24
3 ;
4 ;
5MAIN ;
6 N IBQUIT,IBII,DIRUT,DUOUT,DTOUT,ZTIO,Y S IBQUIT=0
7 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
8 S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC Q:Y<1 S DFN=+Y
9 ;
10 S DIR(0)="DA^::EX",DIR("A")="Start with DATE: "
11 S DIR("?")="Enter the starting date for this report."
12 D ^DIR K DIR G:$D(DIRUT) EXIT S IBSDT=+Y
13 S DIR(0)="DA^"_+Y_":NOW:EX",DIR("A")=" Go to DATE: "
14 S DIR("?")="Enter the ending date for this report."
15 D ^DIR K DIR G:$D(DIRUT) EXIT S IBEDT=+Y
16 ;
17 S DIR(0)="Y",DIR("A")="Include Pharmacy Co-pay charges on this report",DIR("B")="NO"
18 S DIR("?",1)=" Enter: 'Y' - to include Pharmacy Co-pay charges on this report"
19 S DIR("?",2)=" 'N' - to exclude Pharmacy Co-pay charges on this report"
20 S DIR("?")=" '^' - to select a new patient"
21 D ^DIR K DIR G:$D(DIRUT) EXIT S IBIBRX=Y
22 ;
23QUEUED ; entry point if queued
24 ;***
25 K ^TMP($J)
26 D:'$G(IBQUIT) DEVICE D:'$G(IBQUIT) CHRGS,REPORT^IBOHPT2
27 D EXIT
28 ;***
29 Q
30EXIT ;
31 K ^TMP($J)
32 K DFN,IBEND,IBSDT,IBEDT,IBIBRX,IBCN,IBDT,IBIFN,X
33 K IBRDT,IBRF,IBRX,IBRXN
34 I $D(ZTQUEUED) S ZTREQ="@" Q
35 D ^%ZISC
36 Q
37DEVICE ;
38 I $D(ZTQUEUED) Q
39 W !!,*7,"*** Margin width of this output is 132 ***"
40 W !,"*** This output should be queued ***"
41 S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 Q
42 I $D(IO("Q")) S ZTRTN="QUEUED^IBOHPT1",ZTIO=ION,ZTDESC="ON HOLD CHARGE INFO/PT",ZTSAVE("IB*")="",ZTSAVE("DFN")="" D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") D HOME^%ZIS K ZTSK S IBQUIT=1 Q
43 U IO
44 Q
45 ; indexes records that should be included in report
46 ;
47CHRGS ; charges on hold
48 N DATE,IBN,IBND,A,B,C,D,E,IBNX
49 S IBN=0 F S IBN=$O(^IB("C",DFN,IBN)) Q:'IBN S IBND=$G(^IB(IBN,0)) D:IBND
50 .I 'IBIBRX,$E($G(^IBE(350.1,+$P(IBND,"^",3),0)),1,3)="PSO" Q
51 .Q:$P(IBND,"^",8)["ADMISSION"
52 .Q:'$P($G(^IB(IBN,1)),"^",6)
53 .Q:'$D(^IB("APDT",IBN))
54 .S (C,D)="",C=$O(^IB("APDT",IBN,C)),D=$O(^IB("APDT",IBN,C,D))
55 .S E=$P($G(^IB(D,0)),U,3)
56 .S A=$P($G(^IBE(350.1,E,0)),U,5)
57 .S IBNX=$S(A=2:$P($Q(^IB("APDT",IBN,C,D)),")",1),A=3:$P($Q(^IB("APDT",IBN,C,D)),")",1),1:IBN)
58 .I (A=2)!(A=3) D
59 ..I IBNX["[""" S IBNX="^"_$P(IBNX,"]",2)
60 .I $P(IBNX,",",4)>0 S IBNX=$P(IBNX,",",4)
61 .S DATE=$P($G(^IB(+$P(IBND,"^",1),0)),"^",17)
62 .S:'DATE DATE=$P($G(^IB(IBNX,1)),"^",5)
63 .S:'DATE DATE=$P($G(^IB(IBNX,1)),"^",2)\1
64 .I (DATE>(IBSDT-.0001))&(DATE<(IBEDT+.9999)) S ^TMP($J,"IB",-DATE,IBNX)="" D BILLS
65 Q
66 ;
67BILLS ; find bills for charges on hold
68 N IBFR,IBT,IBATYPE,IBTO
69 S IBATYPE=$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["OPT":"O",$P($G(^IBE(350.1,+IBND,"^",3,0)),"^")["PSO":"RX",1:"I")
70 S IBFR=$P(IBND,"^",14),IBTO=$P(IBND,"^",15)
71 I IBATYPE="I" D INP
72 I IBATYPE="O" D OPT
73 E D RX
74 Q
75INP ; inpatient bills
76 N IBEV,IBBILL,IBT,X,X1,X2,IBEND,IBOK
77 S IBEV=$P(IBND,"^",16) Q:'IBEV ; parent event
78 S IBEV=($P($G(^IB(IBEV,0)),"^",17)\1) Q:'IBEV ; date of parent event
79 S X1=IBEV,X2=1 D C^%DTC S IBEND=X
80 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
81 .D INPTCK
82 .I IBOK S ^TMP($J,"IB",-DATE,IBNX,IBBILL)=""
83 Q
84 ;
85INPTCK ; does bill belong to charge? returns IBOK=0 if no
86 N IBBILL0,IBBILLU
87 S IBBILL0=$G(^DGCR(399,IBBILL,0)),IBBILLU=$G(^("U"))
88 S IBOK=1
89CK1 ; for same patient?
90 I DFN=$P(IBBILL0,"^",2)
91 S IBOK=$T
92 Q:'IBOK
93CK2 ; same type- inp or opt?
94 N B S B=$S(+$P(IBBILL0,"^",5)<3:"I",1:"O")
95 I B=IBATYPE
96 S IBOK=$T
97 Q:'IBOK
98CK3 ; overlap in date range?
99 N F,T
100 S F=+IBBILLU,T=$P(IBBILLU,"^",2)
101 I (IBTO<F)!(IBFR>T)
102 S IBOK='$T
103 Q:'IBOK
104CK4 ; insurance bill?
105 I $P(IBBILL0,"^",11)="i"
106 S IBOK=$T
107 Q
108OPT ; outpatient bills
109 N X,IBV,IBBILL,IBOK,IBBILL0
110 S IBV=(IBFR\1)-.0001 F S IBV=$O(^DGCR(399,"AOPV",DFN,IBV)) Q:'IBV!(IBV>IBTO) S IBBILL=0 D
111 .F S IBBILL=$O(^DGCR(399,"AOPV",DFN,IBV,IBBILL)) Q:('IBBILL) D
112 ..Q:$D(^TMP($J,"IB",-DATE,IBNX,IBBILL))
113 ..S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 Q:'IBOK
114 ..S ^TMP($J,"IB",-DATE,IBNX,IBBILL)=""
115 Q
116RX ; rx refill bills
117 Q:'IBIBRX
118 S (IBRX,IBRXN,IBRF,IBRDT)=0 N IENS
119 I $P(IBND,"^",4)'["52:" Q
120 ;
121 S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
122 ;
123 I +IBRF>0 S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
124 I +IBRF=0 S IBRDT=$$FILE^IBRXUTL(+IBRXN,22)
125 ;
126 Q:(IBRX="")!('IBRDT)
127 N X,IBBILL,IBBILL0,IBFILL,IBFILL0,IBOK S IBBILL=0
128 S IBFILL=0 F S IBFILL=$O(^IBA(362.4,"B",IBRX,IBFILL)) Q:IBFILL="" D
129 .S IBFILL0=$G(^IBA(362.4,IBFILL,0)) I $P(IBFILL0,"^",3)'=IBRDT Q
130 .S IBBILL=+$P(IBFILL0,"^",2) I 'IBBILL Q
131 .S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 I 'IBOK Q
132 .S ^TMP($J,"IB",-DATE,IBNX,IBBILL)=""
133 Q
Note: See TracBrowser for help on using the repository browser.