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
;
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBORT1 1454 printed Oct 16, 2024@18:26:40 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
