[613] | 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 | ;
|
---|