Routine: IBORT1

IBORT1 ;ALB/MRL,SGD - MAS BILLING TOTALS REPORT (CONT.)  ;03 JUN 88 09:15

 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 ;MAP TO DGCRORT1

SET S IBTOT=$S('$D(^DGCR(399,DFN,"U1")):0,$P(^DGCR(399,DFN,"U1"),"^",2)]"":$P(^DGCR(399,DFN,"U1"),"^",1)-$P(^DGCR(399,DFN,"U1"),"^",2),1:$P(^DGCR(399,DFN,"U1"),"^",1))

 S IBS=$S($D(^DGCR(399,DFN,"S")):^("S"),1:""),X=$S($D(^DGCR(399.3,+$P(IB,"^",7),0)):$P(^(0),"^",1),1:"UNKNOWN"),IBT=^UTILITY($J,"IB","T",X),IBT1=^UTILITY($J,"IB","T1",X)

 S IBX1=$S($P(IBS,"^",17):11,$P(IBS,"^",14):9,$P(IBS,"^",10):7,$P(IBS,"^",7):5,$P(IBS,"^",4):5,1:3)

 S $P(IBT,"^",1)=$P(IBT,"^",1)+1,$P(IBT,"^",2)=$P(IBT,"^",2)+IBTOT S IBX2=$S(IBX1=9:5,IBX1=11:7,1:3),IBX3=$S(IBX2'=3:0,1:IBX1)

 I IBX3 S $P(IBT1,"^",1)=$P(IBT1,"^",1)+1,$P(IBT1,"^",2)=$P(IBT1,"^",2)+IBTOT,$P(IBT1,"^",IBX3)=$P(IBT1,"^",IBX3)+1,$P(IBT1,"^",IBX3+1)=$P(IBT1,"^",IBX3+1)+IBTOT

 S $P(IBT,"^",IBX2)=$P(IBT,"^",IBX2)+1,$P(IBT,"^",IBX2+1)=$P(IBT,"^",IBX2+1)+IBTOT S ^UTILITY($J,"IB","T",X)=IBT,^UTILITY($J,"IB","T1",X)=IBT1

 S IBT=^UTILITY($J,"IB","TT"),IBT1=^UTILITY($J,"IB","TS") S $P(IBT,"^",1)=$P(IBT,"^",1)+1,$P(IBT,"^",2)=$P(IBT,"^",2)+IBTOT

 S $P(IBT,"^",IBX2)=$P(IBT,"^",IBX2)+1,$P(IBT,"^",IBX2+1)=$P(IBT,"^",IBX2+1)+IBTOT

 I IBX3 S $P(IBT1,"^",1)=$P(IBT1,"^",1)+1,$P(IBT1,"^",2)=$P(IBT1,"^",2)+IBTOT,$P(IBT1,"^",IBX3)=$P(IBT1,"^",IBX3)+1,$P(IBT1,"^",IBX3+1)=$P(IBT1,"^",IBX3+1)+IBTOT

 S ^UTILITY($J,"IB","TT")=IBT,^("TS")=IBT1 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBORT1   1454     printed  Mar 13, 2025@21:31:03                                                                                                                                                                                                      Page 2

IBORT1    ;ALB/MRL,SGD - MAS BILLING TOTALS REPORT (CONT.)  ;03 JUN 88 09:15

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;

 +3       ;MAP TO DGCRORT1

 +4       ;

 +5        QUIT

SET        SET IBTOT=$SELECT('$DATA(^DGCR(399,DFN,"U1")):0,$PIECE(^DGCR(399,DFN,"U1"),"^",2)]"":$PIECE(^DGCR(399,DFN,"U1"),"^",1)-$PIECE(^DGCR(399,DFN,"U1"),"^",2),1:$PIECE(^DGCR(399,DFN,"U1"),"^",1))

 +1        SET IBS=$SELECT($DATA(^DGCR(399,DFN,"S")):^("S"),1:"")

           SET X=$SELECT($DATA(^DGCR(399.3,+$PIECE(IB,"^",7),0)):$PIECE(^(0),"^",1),1:"UNKNOWN")

           SET IBT=^UTILITY($JOB,"IB","T",X)

           SET IBT1=^UTILITY($JOB,"IB","T1",X)

 +2        SET IBX1=$SELECT($PIECE(IBS,"^",17):11,$PIECE(IBS,"^",14):9,$PIECE(IBS,"^",10):7,$PIECE(IBS,"^",7):5,$PIECE(IBS,"^",4):5,1:3)

 +3        SET $PIECE(IBT,"^",1)=$PIECE(IBT,"^",1)+1

           SET $PIECE(IBT,"^",2)=$PIECE(IBT,"^",2)+IBTOT

           SET IBX2=$SELECT(IBX1=9:5,IBX1=11:7,1:3)

           SET IBX3=$SELECT(IBX2'=3:0,1:IBX1)

 +4        IF IBX3

               SET $PIECE(IBT1,"^",1)=$PIECE(IBT1,"^",1)+1

               SET $PIECE(IBT1,"^",2)=$PIECE(IBT1,"^",2)+IBTOT

               SET $PIECE(IBT1,"^",IBX3)=$PIECE(IBT1,"^",IBX3)+1

               SET $PIECE(IBT1,"^",IBX3+1)=$PIECE(IBT1,"^",IBX3+1)+IBTOT

 +5        SET $PIECE(IBT,"^",IBX2)=$PIECE(IBT,"^",IBX2)+1

           SET $PIECE(IBT,"^",IBX2+1)=$PIECE(IBT,"^",IBX2+1)+IBTOT

           SET ^UTILITY($JOB,"IB","T",X)=IBT

           SET ^UTILITY($JOB,"IB","T1",X)=IBT1

 +6        SET IBT=^UTILITY($JOB,"IB","TT")

           SET IBT1=^UTILITY($JOB,"IB","TS")

           SET $PIECE(IBT,"^",1)=$PIECE(IBT,"^",1)+1

           SET $PIECE(IBT,"^",2)=$PIECE(IBT,"^",2)+IBTOT

 +7        SET $PIECE(IBT,"^",IBX2)=$PIECE(IBT,"^",IBX2)+1

           SET $PIECE(IBT,"^",IBX2+1)=$PIECE(IBT,"^",IBX2+1)+IBTOT

 +8        IF IBX3

               SET $PIECE(IBT1,"^",1)=$PIECE(IBT1,"^",1)+1

               SET $PIECE(IBT1,"^",2)=$PIECE(IBT1,"^",2)+IBTOT

               SET $PIECE(IBT1,"^",IBX3)=$PIECE(IBT1,"^",IBX3)+1

               SET $PIECE(IBT1,"^",IBX3+1)=$PIECE(IBT1,"^",IBX3+1)+IBTOT

 +9        SET ^UTILITY($JOB,"IB","TT")=IBT

           SET ^("TS")=IBT1

           QUIT

 +10       QUIT

IBORT1.m