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

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

initial load of WorldVistAEHR

File size: 4.0 KB
RevLine 
[613]1IBCOIVM1 ;ALB/NLR - IB BILLING ACTIVITY (COMPILE/PRINT) ;02-MAY-94
2 ;;2.0;INTEGRATED BILLING;**6,51**;21-MAR-94
3 ;
4LOOP ; get patient from File 354 AIVM X-ref. If still has IVM-identified
5 ; insurance, and bills against IVM-identified policies, put in report.
6 ;
7 K ^TMP("IBOIVM",$J)
8 S DFN=0 F S DFN=$O(^IBA(354,"AIVM",DFN)) Q:'DFN I $$GETIVM(DFN) D
9 .S IBNA=$P($$PT^IBEFUNC(DFN),"^",1,2)
10 .S (IBF,IBIFN)=0 F S IBIFN=$O(^DGCR(399,"C",DFN,IBIFN)) Q:'IBIFN I $D(^DGCR(399,IBIFN,0)),$$HOWID^IBRFN2(IBIFN)=3,$P($G(^DGCR(399,IBIFN,"S")),"^",12),$P($G(^("S")),"^",17)="" S IBF=1 S ^TMP("IBOIVM",$J,IBNA,IBIFN)=""
11 .I 'IBF S ^TMP("IBOIVM",$J,IBNA,0)=""
12 ;
13 ; - print out the report
14 S (IBAB,IBAC,IBQ,IBPAG)=0 D HDR
15 I '$D(^TMP("IBOIVM",$J)) W !!?25,"<< NO PATIENTS WITH POLICIES IDENTIFIED BY IVM >>",! G SEND
16 S IBNA="" F S IBNA=$O(^TMP("IBOIVM",$J,IBNA)) Q:IBNA=""!(IBQ) D
17 .W ! I $Y>(IOSL-5) D PAUSE Q:IBQ D HDR W !
18 .W !?1,$E($P(IBNA,"^"),1,25),?27,$E($P(IBNA,"^",2),1,12)
19 .I $D(^TMP("IBOIVM",$J,IBNA,0)) W ?51,"<< BILLS NOT YET GENERATED AGAINST IVM POLICIES >>" Q
20 .S (IBF,IBIFN)=0 F S IBIFN=$O(^TMP("IBOIVM",$J,IBNA,IBIFN)) Q:'IBIFN!(IBQ) D
21 ..I $Y>(IOSL-5),IBF D PAUSE Q:IBQ D HDR W !!?1,$E($P(IBNA,"^"),1,25),?27,$E($P(IBNA,"^",2),1,14) S IBF=0
22 ..F IBI=0,"S","U" S IBND(IBI)=$G(^DGCR(399,IBIFN,IBI))
23 ..W:IBF !
24 ..W ?41,$P(IBND(0),"^")
25 ..W ?51,$S($$CLO^PRCAFN(IBIFN)>0:"*",1:"")
26 ..W ?57,$$BTYP(IBIFN,IBND(0))
27 ..W ?62,$$DAT1^IBOUTL(+IBND("U")),?76,$$DAT1^IBOUTL($P(IBND("U"),"^",2))
28 ..W ?87,$$DAT1^IBOUTL($P(IBND("S"),"^",12))
29 ..S IBX=$$ORI^PRCAFN(IBIFN),IBAB=IBAB+IBX
30 ..W ?105,$J(IBX,8,2)
31 ..S IBX=$$TPR^PRCAFN(IBIFN),IBAC=IBAC+IBX
32 ..W ?121,$J(IBX,8,2)
33 ..S IBF=1
34 ;
35 G:IBQ ENQ
36 ;
37 ; - print total amounts billed and collected
38 I $Y>(IOSL-7) D PAUSE G:IBQ ENQ D HDR
39 I 'IBAB,'IBAC G SEND
40 W !,?102,"___________",?118,"___________"
41 W !!,?63,"Total Amounts Billed and Collected:" S X=IBAB,X2="2$",X3=16 D COMMA^%DTC W ?95,X S X=IBAC,X2="2$",X3=16 D COMMA^%DTC W ?111,X
42SEND D PAUSE
43 ;
44 ; - send report to the IVM Center if necessary
45 I IBFLG W:$E(IOST,1,2)="C-" !!,"Sending the report in a bulletin to the IVM Center... " D ^IBCOIVM2 W:$E(IOST,1,2)="C-" "done."
46 ;
47ENQ K ^TMP("IBOIVM",$J)
48 I $D(ZTQUEUED) S ZTREQ="@" Q
49 D ^%ZISC
50 K IBFID,IBNA,IBIFN,IBF,IBX,DFN,IBAB,IBAC
51 K DIR,DIRUT,DUOUT,DTOUT,DIROUT
52 K IBQ,IBPAG,IBND,IBINS,X,X2,X3,Y
53ENQ1 Q
54 ;
55 ;
56GETIVM(DFN) ; does patient still have IVM-identified insurance?
57 ; input = dfn
58 ; output = 0 if no ivm-identified insurance
59 ; 1 if ivm-identified insurance
60 ;
61 N IBINS,X,IBFID
62 D ALL^IBCNS1(DFN,"IBINS",0)
63 S IBFID=0 I $G(IBINS(0)) S X=0 F S X=$O(IBINS(X)) Q:'X I $P($G(IBINS(X,1)),"^",9)=3 S IBFID=1 Q
64 Q IBFID
65 ;
66BTYP(BN,X) ; Determine bill type
67 ; Input: BN -- Pointer to the bill in file #399
68 ; X -- Zeroth node of pointed-to bill entry
69 ; Output: Bill Type --> R: Pharmacy Refill
70 ; P: Prosthetics
71 ; I: Inpatient
72 ; O: Outpatient
73 N Y,Z
74 I $G(X)=""!($G(BN)="") S Y="" G BTYPQ
75 I $D(^IBA(362.4,"AIFN"_BN)) S Y="R" G BTYPQ
76 I $D(^IBA(362.5,"AIFN"_BN)) S Y="P" G BTYPQ
77 S Z=$P(X,"^",5),Y=$S(Z=1!(Z=2):"I",1:"O")
78BTYPQ Q Y
79 ;
80PAUSE ; Pause for screen output.
81 Q:$E(IOST,1,2)'="C-"
82 N IBI,DIR,DIRUT,DIROUT,DUOUT,DTOUT
83 F IBI=$Y:1:(IOSL-3) W !
84 S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
85 Q
86 ;
87HDR ; Display report header.
88 N X,Y
89 S X="IVM BILLING ACTIVITY"
90 S Y=$$SITE^VASITE
91 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
92 S IBPAG=IBPAG+1
93 W $J("",56),"IVM BILLING ACTIVITY",!
94 W !,"Facility: ",$P(Y,"^",2)," (",$P(Y,"^",3),")",?101,"Run Date: ",$$DAT1^IBOUTL(DT)," ","Page: ",IBPAG
95 W !,"Types ==> I:Inpatient, O:Outpatient, P:Prosthetics, R:Pharmacy Refill",?80,"Note: '*' after the Bill # denotes a closed bill"
96 W !!,$$DASH,!,?55,"Bill",?89,"Date",?107,"Amt",?125,"Amt"
97 W !,?5,"Patient Name",?32,"SSN",?40,"Bill #",?55,"Type",?62,"Bill From",?75,"-",?79,"To",?86,"Generated",?105,"Billed",?122,"Collected",!,$$DASH
98 Q
99 ;
100DASH() ; Write dashed line.
101 Q $TR($J("",131)," ","=")
Note: See TracBrowser for help on using the repository browser.