IBORAT1C.m

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

	;

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       ;