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

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1IBARXMO ;LL/ELZ - PHARMACY COPAY CAP REPORTS ;21-JAN-2001
2 ;;2.0;INTEGRATED BILLING;**156,261**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CAP ; cap report entry point
6 ; this report will produce a summary of patient's who have met or exceed their cap for the period selected. They may select either a mo/year or just a year.
7 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
8 S DIR(0)="D^::AEMP",DIR("A")="Select a Month/Year or just a Year" D ^DIR
9 Q:$D(DIRUT) S IBD=+Y
10 D DEV("CAPDQ^IBARXMO","Medication Co-Pay Cap Report")
11 Q
12 ;
13CAPDQ ; cap report processing entry
14 N IBP,IBT,IBS,IBDT,IBST,IBM,IBNAM,DFN,IBAB,IBAT,IBDATA,IBTOT K ^TMP("IBARXMO",$J)
15 ;
16 U IO
17 S (IBP,IBAT,IBAB,IBTOT)=0,IBT="Patient/SSN Non-Billed Total Above Cap Patient Priority",IBS=$$SITE^IBARXMU,IBN=IBN_" for ("_$P(IBS,"^",3)_") "_$P(IBS,"^",2)_" - "_$$FMTE^XLFDT(IBD),IBDT=IBD-1
18 D HEAD(IBN,IBT)
19 ;
20 ; build tmp for output
21 ; format ^tmp("ibarxmo",$j,name (last 4),dfn)=total not billed ^ at or above cap
22 ;
23 F S IBDT=$O(^IBAM(354.7,"AC",IBDT)) Q:IBDT<1!($S($E(IBD,4,5)="00"&($E(IBD,1,3)'=$E(IBDT,1,3)):1,$E(IBD,4,5)'="00"&($E(IBDT,1,5)'=$E(IBD,1,5)):1,1:0)) S IBST=0 F S IBST=$O(^IBAM(354.7,"AC",IBDT,IBST)) Q:IBST<1 D
24 . S DFN=0 F S DFN=$O(^IBAM(354.7,"AC",IBDT,IBST,DFN)) Q:DFN<1 D DEM^VADPT S IBM=0 F S IBM=$O(^IBAM(354.7,"AC",IBDT,IBST,DFN,IBM)) Q:IBM<1 D
25 .. S IBNAM=$E(VADM(1),1,25)_" ("_VA("BID")_")",^TMP("IBARXMO",$J,IBNAM,DFN)=$G(^TMP("IBARXMO",$J,IBNAM,DFN))+$P(^IBAM(354.7,DFN,1,IBM,0),"^",4)_"^"_IBST
26 ;
27 ; now lets do some printing
28 S IBNAM=0 F S IBNAM=$O(^TMP("IBARXMO",$J,IBNAM)) Q:IBNAM=""!($D(DIRUT)) S DFN=0 F S DFN=$O(^TMP("IBARXMO",$J,IBNAM,DFN)) Q:DFN<1!($D(DIRUT)) D
29 . S IBDATA=^TMP("IBARXMO",$J,IBNAM,DFN)
30 . W !,IBNAM,?37,$J($FN(+IBDATA,",",2),12),?53,$S($P(IBDATA,"^",2)=1:"At Cap",1:"Above Cap"),?71,$$PRIORITY^IBARXMU(DFN)
31 . S @$S($P(IBDATA,"^",2)=1:"IBAT",1:"IBAB")=@$S($P(IBDATA,"^",2)=1:"IBAT",1:"IBAB")+1,IBTOT=IBTOT+IBDATA
32 . D:$Y+3>IOSL HEAD(IBN,IBT)
33 ;
34 W !!,?12,"Patient Count At Cap: ",$J($FN(IBAT,",",0),12)
35 W !,?9,"Patient Count Above Cap: ",$J($FN(IBAB,",",0),12)
36 W !,?18,"Total Unbilled: ",?37,$J($FN(IBTOT,",",2),12)
37 ;
38 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR
39 ;
40 K IBR,IBN,IBD,^TMP("IBARXMO",$J)
41 ;
42 D ^%ZISC
43 S:$D(ZTQUEUED) ZTREQ="@"
44 ;
45 Q
46NOBILL ; non-billable report entry point
47 ; this report will produce a list of copay transaction which could not be billed (fully or partly) for the Month/Year selected.
48 ;
49 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
50 S DIR(0)="D^::AEMPX",DIR("A")="Select a Month/Year" D ^DIR
51 Q:$D(DIRUT) S IBD=+Y
52 D DEV("NOBILLDQ^IBARXMO","Non-Billable Copayments Report")
53 Q
54NOBILLDQ ; entry point to produce the non-billable report
55 N IBDT,IBP,IBT,IBX,IBZ,DFN,IBS
56 U IO
57 ;
58 S IBP=0,IBS=+$P($$SITE^IBARXMU,"^",3),IBN=IBN_" - "_$$FMTE^XLFDT(IBD),IBT="Patient/SSN Rx # Date Drug Amount" D HEAD(IBN,IBT)
59 ;
60 S IBDT=IBD F S IBDT=$O(^IBAM(354.71,"AE",IBDT)) Q:IBDT<1!($D(DIRUT))!($E(IBDT,1,5)'=$E(IBD,1,5)) S IBX=0 F S IBX=$O(^IBAM(354.71,"AE",IBDT,IBX)) Q:IBX<1 D
61 . S IBZ=^IBAM(354.71,IBX,0),$P(IBZ,"^",12)=$P($$NET^IBARXMC(IBX),"^",2)
62 . Q:$P(IBZ,"^",12)'>0!($P(IBZ,"^",10)'=IBX)!($E(IBZ,1,3)'=IBS)
63 . S DFN=$P(IBZ,"^",2) D DEM^VADPT
64 . W !,$E(VADM(1),1,25)_" ("_VA("BID")_")",?32,$P($P(IBZ,"^",9),"-"),?43,$$FMTE^XLFDT(IBDT),?58,$E($P($P(IBZ,"^",9),"-",2),1,13),?72,$J($FN($P(IBZ,"^",12),",",2),8)
65 . D:$Y+3>IOSL HEAD(IBN,IBT)
66 ;
67 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR
68 ;
69 D ^%ZISC
70 S:$D(ZTQUEUED) ZTREQ="@"
71 ;
72 Q
73DEV(IBR,IBN) ; device selection
74 ; IBR=routine, IBN=task name (only used of tasked)
75 N %ZIS,ZTSK,ZTSAVE,POP,ZTRTN,ZTDESC
76 S %ZIS="MQ" D ^%ZIS Q:POP
77 I $D(IO("Q")) D Q
78 . S ZTRTN=IBR,ZTDESC=IBN,ZTSAVE("IB*")=""
79 . D ^%ZTLOAD,HOME^%ZIS K IO("Q") W !,"QUEUED TASK #",ZTSK
80 D @IBR
81 ;
82 Q
83HEAD(IBX,IBY) ; print header
84 ; IBX=report name, IBY=data description for second line
85 ; IBP is assumed for page #
86 N DIR,X,Y
87 I $E(IOST,1,2)="C-",IBP S DIR(0)="E" D ^DIR
88 S IBP=IBP+1
89 W @IOF,!,IBX,?IOM-10,"Page: ",IBP,!,IBY,! F X=1:1:IOM W "-"
90 W !
91 Q
Note: See TracBrowser for help on using the repository browser.