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

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBORAT1C   2017     printed  Feb 18, 2025@23:52:30                                                                                                                                                                                                    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       ;