IBORAT1C ;ALB/RJS - OUTPUT ROUTINE FOR IB ACTION CHARGES - 2/26/92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
INIT ;
S Y=DT X ^DD("DD") S IBTODAY=Y
;
;IBSTDATE & IBENDATE USED BY 2 ROUTINES SO DON'T WANT TO SET THEM HERE
;IBSDATE,IBEDATE,IBTODAY,IBTITLE,IBPAGE,IBDONE,IBOUTPUT,IBSTDATE,IBENDATE
;USED BY IBORAT2C SO DON'T WANT TO KILL THEM HERE
;
S Y=IBSTDATE D DD^%DT S IBSDATE=Y
S Y=IBENDATE D DD^%DT S IBEDATE=Y
S IBTITLE="***Billing Rates Listing***",IBDONE=0,IBPAGE=1
IBSPEC ;
S IBROUT="IBORAT1A",IBSPEC="",IBOLDSPC=""
F S IBSPEC=$O(^TMP($J,IBROUT,IBSPEC)) Q:IBSPEC=""!(IBDONE) D IBSPEC2
END ;
K IBAAA,IBCANCEL,IBEFFDAT,IBOLDSPC,IBROUT,IBSPEC,IBX,Y
Q
IBSPEC2 ;
S IBEFFDAT=-1
F S IBEFFDAT=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT)) Q:IBEFFDAT=""!(IBDONE) D OUTPUT:$$SELECT(IBEFFDAT)
Q
OUTPUT ;
I IBOUTPUT=0 D IBTITLE S (IBOUTPUT,IBZ)=1
I IBOLDSPC'=IBSPEC&($Y+8>IOSL) S IBOLDSPC=IBSPEC D HEADING G LINE
I IBOLDSPC'=IBSPEC S IBOLDSPC=IBSPEC D SUBHEAD
LINE ;
I IBDONE Q
D:$Y+4>IOSL HEADING
I IBDONE Q
S Y=IBEFFDAT D DD^%DT
W !,?2,Y,?22,"$",$P(^TMP($J,IBROUT,IBSPEC,IBEFFDAT),U,2)
I $P(^(IBEFFDAT),U,3) W ?32,"$",$P(^(IBEFFDAT),U,3)
Q
SUBHEAD ;
W !!,IBSPEC,!,?2,"Effective Date",?22,"Amount",?32,"Additional Amount"
Q
HEADING ;
F IBAAA=$Y:1:(IOSL-3) W !
I ($E(IOST,1,2)="C-")
I S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="")!($D(DIRUT)) S IBDONE=1 Q
D IBTITLE,SUBHEAD
Q
IBTITLE ; initial form feeds to crts subsequent form feeds to all
W:$E(IOST,1,2)["C-"!(IBPAGE>1) @IOF W IBTODAY,?25,IBTITLE,?68," PAGE ",IBPAGE
D DATES
S IBX="",$P(IBX,"=",IOM)="" W IBX
S IBPAGE=IBPAGE+1
Q
DATES ;
I IBSDATE=IBEDATE W !,?25," Rates in effect on: ",IBSDATE,! Q
W !,?25," Rates in effect from: ",IBSDATE
W !,?25," to: ",IBEDATE,!
Q
SELECT(IBEFFDAT) ;
S IBCANCEL=$P(^TMP($J,IBROUT,IBSPEC,IBEFFDAT),U,1)
I (IBSTDATE'>IBEFFDAT)&(IBENDATE'<IBEFFDAT) Q 1
I (IBSTDATE'<IBEFFDAT)&(IBSTDATE'>IBCANCEL) Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBORAT1C 2017 printed Nov 22, 2024@17:36:04 Page 2
IBORAT1C ;ALB/RJS - OUTPUT ROUTINE FOR IB ACTION CHARGES - 2/26/92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
INIT ;
+1 SET Y=DT
XECUTE ^DD("DD")
SET IBTODAY=Y
+2 ;
+3 ;IBSTDATE & IBENDATE USED BY 2 ROUTINES SO DON'T WANT TO SET THEM HERE
+4 ;IBSDATE,IBEDATE,IBTODAY,IBTITLE,IBPAGE,IBDONE,IBOUTPUT,IBSTDATE,IBENDATE
+5 ;USED BY IBORAT2C SO DON'T WANT TO KILL THEM HERE
+6 ;
+7 SET Y=IBSTDATE
DO DD^%DT
SET IBSDATE=Y
+8 SET Y=IBENDATE
DO DD^%DT
SET IBEDATE=Y
+9 SET IBTITLE="***Billing Rates Listing***"
SET IBDONE=0
SET IBPAGE=1
IBSPEC ;
+1 SET IBROUT="IBORAT1A"
SET IBSPEC=""
SET IBOLDSPC=""
+2 FOR
SET IBSPEC=$ORDER(^TMP($JOB,IBROUT,IBSPEC))
if IBSPEC=""!(IBDONE)
QUIT
DO IBSPEC2
END ;
+1 KILL IBAAA,IBCANCEL,IBEFFDAT,IBOLDSPC,IBROUT,IBSPEC,IBX,Y
+2 QUIT
IBSPEC2 ;
+1 SET IBEFFDAT=-1
+2 FOR
SET IBEFFDAT=$ORDER(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT))
if IBEFFDAT=""!(IBDONE)
QUIT
if $$SELECT(IBEFFDAT)
DO OUTPUT
+3 QUIT
OUTPUT ;
+1 IF IBOUTPUT=0
DO IBTITLE
SET (IBOUTPUT,IBZ)=1
+2 IF IBOLDSPC'=IBSPEC&($Y+8>IOSL)
SET IBOLDSPC=IBSPEC
DO HEADING
GOTO LINE
+3 IF IBOLDSPC'=IBSPEC
SET IBOLDSPC=IBSPEC
DO SUBHEAD
LINE ;
+1 IF IBDONE
QUIT
+2 if $Y+4>IOSL
DO HEADING
+3 IF IBDONE
QUIT
+4 SET Y=IBEFFDAT
DO DD^%DT
+5 WRITE !,?2,Y,?22,"$",$PIECE(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT),U,2)
+6 IF $PIECE(^(IBEFFDAT),U,3)
WRITE ?32,"$",$PIECE(^(IBEFFDAT),U,3)
+7 QUIT
SUBHEAD ;
+1 WRITE !!,IBSPEC,!,?2,"Effective Date",?22,"Amount",?32,"Additional Amount"
+2 QUIT
HEADING ;
+1 FOR IBAAA=$Y:1:(IOSL-3)
WRITE !
+2 IF ($EXTRACT(IOST,1,2)="C-")
+3 IF $TEST
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y=0!(Y="")!($DATA(DIRUT))
SET IBDONE=1
QUIT
+4 DO IBTITLE
DO SUBHEAD
+5 QUIT
IBTITLE ; initial form feeds to crts subsequent form feeds to all
+1 if $EXTRACT(IOST,1,2)["C-"!(IBPAGE>1)
WRITE @IOF
WRITE IBTODAY,?25,IBTITLE,?68," PAGE ",IBPAGE
+2 DO DATES
+3 SET IBX=""
SET $PIECE(IBX,"=",IOM)=""
WRITE IBX
+4 SET IBPAGE=IBPAGE+1
+5 QUIT
DATES ;
+1 IF IBSDATE=IBEDATE
WRITE !,?25," Rates in effect on: ",IBSDATE,!
QUIT
+2 WRITE !,?25," Rates in effect from: ",IBSDATE
+3 WRITE !,?25," to: ",IBEDATE,!
+4 QUIT
SELECT(IBEFFDAT) ;
+1 SET IBCANCEL=$PIECE(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT),U,1)
+2 IF (IBSTDATE'>IBEFFDAT)&(IBENDATE'<IBEFFDAT)
QUIT 1
+3 IF (IBSTDATE'<IBEFFDAT)&(IBSTDATE'>IBCANCEL)
QUIT 1
+4 QUIT 0
+5 ;
