source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCOPR.m@ 1420

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

initial load of FOIAVistA 6/30/08 version
File size: 5.8 KB
Line 
1IBCOPR ;WISC/RFJ,BOISE/WRL-print dollar amts for pre-registration ; 05 May 97 8:30 AM [7/22/03 11:59am]
2 ;;2.0; INTEGRATED BILLING ;**75,345**; 21-MAR-94;Build 28
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 W !!,"This report will sort through insurance policies in the patient file"
6 W !,"and print patients, bills, and payments with an insurance policy source"
7 W !,"of information equal to the user selected criteria."
8 ;
9 N DATEEND,DATESTRT,IBCNFSUM,IBCNESOI
10 ;
11 ; select date range
12 W ! D DATESEL I '$G(DATEEND) Q
13 ;
14 ; select Source of Information (SOI)
15 W ! D SOISEL I '$D(IBCNESOI) Q
16 ;
17 S IBCNFSUM=$$SUMMARY I 'IBCNFSUM Q
18 ;
19 W !!,"Since this report has to loop through all patients and check all insurance"
20 W !,"policies, it is recommended this report be queued."
21 ;
22 ; select device
23 W ! S %ZIS="Q" D ^%ZIS Q:POP
24 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
25 . S ZTDESC="Source of Information Report",ZTRTN="DQ^IBCOPR"
26 . S ZTSAVE("DATE*")="",ZTSAVE("IBCN*")="",ZTSAVE("ZTREQ")="@"
27 ;
28 W !!,"<*> please wait <*>"
29 ;
30DQ ; report (queue) starts here
31 N AMOUNT,BILLNUM,CANCEL,CLASS,COUNTNEW,DA,DATA,DATE,DFN,INSCO,PAYMTAMT,PAYMTCNT,TOTALAMT,TOTALCNT,TRANDA,VA,Y,SOI
32 K ^TMP($J,"IBCOPR")
33 S COUNTNEW=0
34 ;
35 ; build list of patients using source
36 S INSCO=0 F S INSCO=$O(^DPT("AB",INSCO)) Q:'INSCO D
37 . S DFN=0 F S DFN=$O(^DPT("AB",INSCO,DFN)) Q:'DFN D
38 . . S DA=0 F S DA=$O(^DPT("AB",INSCO,DFN,DA)) Q:'DA D
39 . . . S DATA=$G(^DPT(DFN,.312,DA,1))
40 . . . S DATE=$P($P(DATA,"^",10),".")
41 . . . S SOI=$P(DATA,"^",9)
42 . . . ;
43 . . . ; Check for existence of SOI
44 . . . I $G(SOI)="" Q
45 . . . ;
46 . . . ; check source of information
47 . . . I $G(IBCNESOI)'=1,$G(IBCNESOI(SOI))="" Q
48 . . . ;
49 . . . ; build list of all patients
50 . . . D PID^VADPT
51 . . . S Y=$P(DATE,".") D DD^%DT
52 . . . S ^TMP($J,"IBCOPR","ALL",DFN,INSCO)=$P($G(^DPT(DFN,0)),"^")_"^"_$G(VA("BID"))_"^"_Y_"^"_SOI
53 . . . ;
54 . . . ; check date of source of information
55 . . . I DATE<DATESTRT!(DATE>DATEEND) Q
56 . . . ;
57 . . . ; build list of patients match during select date range
58 . . . S COUNTNEW(SOI)=$G(COUNTNEW(SOI))+1
59 . . . S COUNTNEW=COUNTNEW+1
60 . . . S ^TMP($J,"IBCOPR","NEW",SOI,DFN,INSCO)=""
61 ;
62 ; get charges and payments
63 S DFN=0 F S DFN=$O(^TMP($J,"IBCOPR","ALL",DFN)) Q:'DFN D
64 . S INSCO=0 F S INSCO=$O(^TMP($J,"IBCOPR","ALL",DFN,INSCO)) Q:'INSCO D
65 . . S SOI=$P(^TMP($J,"IBCOPR","ALL",DFN,INSCO),"^",4)
66 . . S DA=0 F S DA=$O(^DGCR(399,"AE",DFN,INSCO,DA)) Q:'DA D
67 . . . ; date first printed, bill classification
68 . . . S DATE=$P($P($G(^DGCR(399,DA,"S")),"^",12),".")
69 . . . S CLASS=$P($G(^DGCR(399,DA,0)),"^",5)
70 . . . ;
71 . . . ; check for 1 or 2 inpatient, 3 or 4 outpatient
72 . . . S CLASS=$S(CLASS<3:1,1:3)
73 . . . ;
74 . . . ; bill canceled
75 . . . S CANCEL="" I $P($G(^DGCR(399,DA,"S")),"^",16)=1 S CANCEL="*"
76 . . . S BILLNUM=$P($G(^DGCR(399,DA,0)),"^")
77 . . . S AMOUNT=+$$ORI^PRCAFN(DA) I AMOUNT'>0 Q
78 . . . ;
79 . . . I DATE'<DATESTRT,DATE'>DATEEND D
80 . . . . S ^TMP($J,"IBCOPR","BILL",SOI,CLASS,DATE,DA)=DFN_"^"_INSCO_"^"_CANCEL_"^"_BILLNUM_"^"_AMOUNT
81 . . . . I CANCEL="" S TOTALCNT(SOI,CLASS)=$G(TOTALCNT(SOI,CLASS))+1,TOTALAMT(SOI,CLASS)=$G(TOTALAMT(SOI,CLASS))+AMOUNT
82 . . . ;
83 . . . ; get payments
84 . . . S TRANDA=0 F S TRANDA=$O(^PRCA(433,"C",DA,TRANDA)) Q:'TRANDA D
85 . . . . S DATA=$G(^PRCA(433,TRANDA,1))
86 . . . . ; transaction type 2 and 34 are payments
87 . . . . I $P(DATA,"^",2)'=2,$P(DATA,"^",2)'=34 Q
88 . . . . S DATE=$P($P(DATA,"^",9),".")
89 . . . . I DATE<DATESTRT!(DATE>DATEEND) Q
90 . . . . I '$P($G(^PRCA(433,TRANDA,0)),"^",4) Q
91 . . . . S AMOUNT=$P($G(^PRCA(433,TRANDA,3)),"^")
92 . . . . S ^TMP($J,"IBCOPR","TRAN",SOI,CLASS,DATE,DA)=DFN_"^"_INSCO_"^"_CANCEL_"^"_TRANDA_"^"_$P(DATA,"^",2)_"^"_AMOUNT
93 . . . . I CANCEL="" S PAYMTCNT(SOI,CLASS)=$G(PAYMTCNT(SOI,CLASS))+1,PAYMTAMT(SOI,CLASS)=$G(PAYMTAMT(SOI,CLASS))+AMOUNT
94 ;
95 S SOI=0
96 F S SOI=$O(TOTALCNT(SOI)) Q:SOI="" I $G(COUNTNEW(SOI))="" S COUNTNEW(SOI)=0
97 F S SOI=$O(PAYMTCNT(SOI)) Q:SOI="" I $G(COUNTNEW(SOI))="" S COUNTNEW(SOI)=0
98 D PRINT^IBCOPR1
99 ;
100 D ^%ZISC
101 K ^TMP($J,"IBCOPR")
102 Q
103 ;
104 ;
105DATESEL ; select starting and ending dates in days
106 ; returns datestrt and dateend
107 N %,%DT,%H,%I,DEFAULT,X,Y
108 K DATEEND,DATESTRT
109START S Y=$E(DT,1,5)_"01" D DD^%DT S DEFAULT=Y
110 S %DT("A")="Start with Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
111 I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
112 S DATESTRT=Y
113 S Y=DT D DD^%DT S DEFAULT=Y
114 S %DT("A")=" End with Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
115 I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
116 I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START
117 S DATEEND=Y,Y=DATESTRT D DD^%DT
118 W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"
119 Q
120 ;
121 ;;
122SOISEL ; Select one SOI (source of information) or ALL - File #355.12
123 NEW DIC,DTOUT,DUOUT,X,Y,CT,Q
124 K IBCNESOI S CT=0 W !?5,"Enter Sources of Information to include one at a time."
125SOISEL1 S DIC(0)="AMEQ"
126 S Q="Include Source of Information"
127 I CT=0 S Q=Q_" (<RETURN> for ALL)"
128 E S Q="Also "_Q
129 S DIC("A")=$$FO^IBCNEUT1(Q_": ",50,"R")
130 S DIC="^IBE(355.12,"
131 D ^DIC
132 I $D(DUOUT)!$D(DTOUT) G SOISELX
133 ; If nothing was selected (Y=-1), select ALL sources
134 I Y=-1 G SOISELX:CT=1 S IBCNESOI=1 G SOISELX
135 S IBCNESOI($P(Y,"^",1))=$P(Y,"^",2),CT=1 G SOISEL1
136 ;
137SOISELX ; SOISEL exit pt
138 Q
139 ;
140SUMMARY() ; ask to print detailed or summary report
141 N DIR,DIRUT,X,Y
142 S DIR(0)="SOA^D:detailed;S:summary;",DIR("B")="summary"
143 S DIR("A")="Type of report to print: "
144 W ! D ^DIR
145 I $D(DIRUT) Q 0
146 Q $S(Y="S":1,Y="D":2,1:0)
147 ;
Note: See TracBrowser for help on using the repository browser.