| 1 | IBORAT1C ;ALB/RJS - OUTPUT ROUTINE FOR IB ACTION CHARGES - 2/26/92
 | 
|---|
| 2 |  ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
 | 
|---|
| 3 | INIT ;
 | 
|---|
| 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
 | 
|---|
| 13 | IBSPEC ;
 | 
|---|
| 14 |  S IBROUT="IBORAT1A",IBSPEC="",IBOLDSPC=""
 | 
|---|
| 15 |  F  S IBSPEC=$O(^TMP($J,IBROUT,IBSPEC)) Q:IBSPEC=""!(IBDONE)  D IBSPEC2
 | 
|---|
| 16 | END ;
 | 
|---|
| 17 |  K IBAAA,IBCANCEL,IBEFFDAT,IBOLDSPC,IBROUT,IBSPEC,IBX,Y
 | 
|---|
| 18 |  Q
 | 
|---|
| 19 | IBSPEC2 ;
 | 
|---|
| 20 |  S IBEFFDAT=-1
 | 
|---|
| 21 |  F  S IBEFFDAT=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT)) Q:IBEFFDAT=""!(IBDONE)  D OUTPUT:$$SELECT(IBEFFDAT)
 | 
|---|
| 22 |  Q
 | 
|---|
| 23 | OUTPUT ;
 | 
|---|
| 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
 | 
|---|
| 27 | LINE ;
 | 
|---|
| 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
 | 
|---|
| 35 | SUBHEAD ;
 | 
|---|
| 36 |  W !!,IBSPEC,!,?2,"Effective Date",?22,"Amount",?32,"Additional Amount"
 | 
|---|
| 37 |  Q
 | 
|---|
| 38 | HEADING ;
 | 
|---|
| 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
 | 
|---|
| 44 | IBTITLE ; 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
 | 
|---|
| 50 | DATES ;
 | 
|---|
| 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
 | 
|---|
| 55 | SELECT(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 |  ;
 | 
|---|