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

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1IBORAT1C ;ALB/RJS - OUTPUT ROUTINE FOR IB ACTION CHARGES - 2/26/92
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3INIT ;
4 S Y=DT X ^DD("DD") S IBTODAY=Y
5 ;
6 ;IBSTDATE & IBENDATE USED BY 2 ROUTINES SO DON'T WANT TO SET THEM HERE
7 ;IBSDATE,IBEDATE,IBTODAY,IBTITLE,IBPAGE,IBDONE,IBOUTPUT,IBSTDATE,IBENDATE
8 ;USED BY IBORAT2C SO DON'T WANT TO KILL THEM HERE
9 ;
10 S Y=IBSTDATE D DD^%DT S IBSDATE=Y
11 S Y=IBENDATE D DD^%DT S IBEDATE=Y
12 S IBTITLE="***Billing Rates Listing***",IBDONE=0,IBPAGE=1
13IBSPEC ;
14 S IBROUT="IBORAT1A",IBSPEC="",IBOLDSPC=""
15 F S IBSPEC=$O(^TMP($J,IBROUT,IBSPEC)) Q:IBSPEC=""!(IBDONE) D IBSPEC2
16END ;
17 K IBAAA,IBCANCEL,IBEFFDAT,IBOLDSPC,IBROUT,IBSPEC,IBX,Y
18 Q
19IBSPEC2 ;
20 S IBEFFDAT=-1
21 F S IBEFFDAT=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT)) Q:IBEFFDAT=""!(IBDONE) D OUTPUT:$$SELECT(IBEFFDAT)
22 Q
23OUTPUT ;
24 I IBOUTPUT=0 D IBTITLE S (IBOUTPUT,IBZ)=1
25 I IBOLDSPC'=IBSPEC&($Y+8>IOSL) S IBOLDSPC=IBSPEC D HEADING G LINE
26 I IBOLDSPC'=IBSPEC S IBOLDSPC=IBSPEC D SUBHEAD
27LINE ;
28 I IBDONE Q
29 D:$Y+4>IOSL HEADING
30 I IBDONE Q
31 S Y=IBEFFDAT D DD^%DT
32 W !,?2,Y,?22,"$",$P(^TMP($J,IBROUT,IBSPEC,IBEFFDAT),U,2)
33 I $P(^(IBEFFDAT),U,3) W ?32,"$",$P(^(IBEFFDAT),U,3)
34 Q
35SUBHEAD ;
36 W !!,IBSPEC,!,?2,"Effective Date",?22,"Amount",?32,"Additional Amount"
37 Q
38HEADING ;
39 F IBAAA=$Y:1:(IOSL-3) W !
40 I ($E(IOST,1,2)="C-")
41 I S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="")!($D(DIRUT)) S IBDONE=1 Q
42 D IBTITLE,SUBHEAD
43 Q
44IBTITLE ; initial form feeds to crts subsequent form feeds to all
45 W:$E(IOST,1,2)["C-"!(IBPAGE>1) @IOF W IBTODAY,?25,IBTITLE,?68," PAGE ",IBPAGE
46 D DATES
47 S IBX="",$P(IBX,"=",IOM)="" W IBX
48 S IBPAGE=IBPAGE+1
49 Q
50DATES ;
51 I IBSDATE=IBEDATE W !,?25," Rates in effect on: ",IBSDATE,! Q
52 W !,?25," Rates in effect from: ",IBSDATE
53 W !,?25," to: ",IBEDATE,!
54 Q
55SELECT(IBEFFDAT) ;
56 S IBCANCEL=$P(^TMP($J,IBROUT,IBSPEC,IBEFFDAT),U,1)
57 I (IBSTDATE'>IBEFFDAT)&(IBENDATE'<IBEFFDAT) Q 1
58 I (IBSTDATE'<IBEFFDAT)&(IBSTDATE'>IBCANCEL) Q 1
59 Q 0
60 ;
Note: See TracBrowser for help on using the repository browser.