IBOST ;ALB/AAS - INTEGRATED BILLING STATISTICAL REPORT ; 8-MAR-91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
EN ;
;***
;S XRTL=$ZU(0),XRTN="IBOST-1" D T0^%ZOSV ;start rt clock
D HOME^%ZIS W @IOF,*13,?20,"Integrated Billing Statistical Report"
W !! D DATE^IBOUTL I IBEDT="" G END
DEV S %ZIS="QM",%ZIS("A")="Output Device: " D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="DQ^IBOST",ZTDESC="IB Statistical Report",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q"),ZTSK G END
U IO
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOST" D T1^%ZOSV ;stop rt clock
W !!
;
DQ ; -entry from tasked job
;***
;S XRTL=$ZU(0),XRTN="IBOST-2" D T0^%ZOSV ;start rt clock
K ^TMP($J)
S IBN="" F IBDT=IBBDT:0 S IBDT=$O(^IB("D",IBDT)) Q:'IBDT!(IBDT>(IBEDT+.24)) F IBN=0:0 S IBN=$O(^IB("D",IBDT,IBN)) Q:'IBN I $D(^IB(IBN,0)) D GROSS,NET:$P(^IB(IBN,0),"^",9)=IBN
;
D PRINT W !
G END
;
GROSS ; -gross count of action types, total charges
; -^tmp($j,"ib",ibaction type,"gcnt")=count
; ^tmp($j,"ib",ibaction type,"gtot")=sum of charges
;
S IBND=^IB(IBN,0)
S IBATYP=$S($D(^IBE(350.1,+$P(IBND,"^",3),0)):$P(^(0),"^"),1:"UNKNOWN"),IBSEQNO=$S($D(^IBE(350.1,+$P(IBND,"^",3),0)):$P(^(0),"^",5),1:0)
S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"GCNT")) ^("GCNT")=0 S ^("GCNT")=^("GCNT")+1
S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"GTOT")) ^("GTOT")=0 S ^("GTOT")=^("GTOT")+$P(IBND,"^",7)
Q
;
NET ; -net count of new actions that aren't cancelled
; -^tmp($j,"ib",ibaction type,"ncnt")=net count
; ^tmp($j,"ib",ibaction type,"ntot")=net total
S IBLAST="",IBLDT=$O(^IB("APDT",IBN,"")) I +IBLDT F IBL=0:0 S IBL=$O(^IB("APDT",IBN,IBLDT,IBL)) Q:'IBL S IBLAST=IBL
Q:'IBLAST
Q:'$D(^IB(IBLAST,0))
S IBCHRG=$P(^IB(IBLAST,0),"^",7),IBSEQNOL=$S($D(^IBE(350.1,$P(^IB(IBLAST,0),"^",3),0)):$P(^(0),"^",5),1:"")
S:IBSEQNOL=2 IBCHRG=0
S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"NTOT")) ^("NTOT")=0 S ^("NTOT")=^("NTOT")+(IBCHRG)
S:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"NCNT")) ^("NCNT")=0 S ^("NCNT")=^("NCNT")+$S(IBSEQNOL=2:0,1:1)
Q
;
PRINT ; -output data
S IBQUIT=0,IBPAG=0,Y=DT D D^DIQ S IBHDT=Y D HDR
W !!?((IOM-25)/2),"NET TOTALS BY ACTION TYPE"
F IBSEQNO=0:0 S IBSEQNO=$O(^TMP($J,"IB",IBSEQNO)) Q:'IBSEQNO!(IBQUIT) S IBATYP="" F IBT=0:0 S IBATYP=$O(^TMP($J,"IB",IBSEQNO,IBATYP)) Q:IBATYP=""!(IBQUIT) D NETLIN
;
W !!?((IOM-27)/2),"GROSS TOTALS BY ACTION TYPE"
F IBSEQNO=0:0 S IBSEQNO=$O(^TMP($J,"IB",IBSEQNO)) Q:'IBSEQNO!(IBQUIT) S IBATYP="" F IBT=0:0 S IBATYP=$O(^TMP($J,"IB",IBSEQNO,IBATYP)) Q:IBATYP=""!(IBQUIT) D LINE
Q
;
LINE ;
I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
W !!?((IOM/2)-$L($P(IBATYP," ",2,99))),$P(IBATYP," ",2,99)
W !?((IOM/2)-12),"NUMBER ENTRIES: ",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"GCNT")):^("GCNT"),1:0)
W !?((IOM/2)-12),"DOLLAR AMOUNT: $",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"GTOT")):^("GTOT"),1:0)
Q
;
NETLIN ;
I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
Q:'$D(^TMP($J,"IB",IBSEQNO,IBATYP,"NCNT"))
W !!?((IOM/2)-$L($P(IBATYP," ",2,99))),$P(IBATYP," ",2,99)
W !?((IOM/2)-12),"NUMBER ENTRIES: ",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"NCNT")):^("NCNT"),1:0)
W !?((IOM/2)-12),"DOLLAR AMOUNT: $",$S($D(^TMP($J,"IB",IBSEQNO,IBATYP,"NTOT")):^("NTOT"),1:0)
Q
HDR ;
W:$E(IOST,1,2)["C-"!(IBPAG>0) @IOF,*13
W ?((IOM-37)/2),"INTEGRATED BILLING STATISTICAL REPORT"
W !?((IOM-3)/2),"for"
D SITE^IBAUTL S IBSNM=$S($D(^DIC(4,IBFAC,0)):$P(^(0),"^"),1:"")
W !?((IOM-($L(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
W !!?(IOM-18/2),"From: " S Y=IBBDT D DT^DIQ
W !?((IOM-16)/2),"To: " S Y=IBEDT D DT^DIQ
W !!?(IOM-26/2),"Date Printed: ",IBHDT
S IBPAG=IBPAG+1 W !?(IOM-8/2),"Page: ",IBPAG
W !?(IOM-26/2),"--------------------------"
Q
;
END K ^TMP($J)
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOST" D T1^%ZOSV ;stop rt clock
I $D(ZTQUEUED) S ZTREQ="@" Q
K DUOUT,IBT,IBBDT,IBEDT,IBATYP,IBSEQNO,IBHDT,IBPAG,IBSNM,IBFAC,IBSITE,IBSEQNOL,IBLAST,IBL,IBCHRG,IBDT,IBJ,IBLDT,IBN,IBND,IBQUIT,X,Y
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOST 3971 printed Apr 09, 2024@21:37:32 Page 2
IBOST ;ALB/AAS - INTEGRATED BILLING STATISTICAL REPORT ; 8-MAR-91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
EN ;
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBOST-1" D T0^%ZOSV ;start rt clock
+3 DO HOME^%ZIS
WRITE @IOF,*13,?20,"Integrated Billing Statistical Report"
+4 WRITE !!
DO DATE^IBOUTL
IF IBEDT=""
GOTO END
DEV SET %ZIS="QM"
SET %ZIS("A")="Output Device: "
DO ^%ZIS
if POP
GOTO END
+1 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBOST"
SET ZTDESC="IB Statistical Report"
SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
GOTO END
+2 USE IO
+3 ;***
+4 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOST" D T1^%ZOSV ;stop rt clock
+5 WRITE !!
+6 ;
DQ ; -entry from tasked job
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBOST-2" D T0^%ZOSV ;start rt clock
+3 KILL ^TMP($JOB)
+4 SET IBN=""
FOR IBDT=IBBDT:0
SET IBDT=$ORDER(^IB("D",IBDT))
if 'IBDT!(IBDT>(IBEDT+.24))
QUIT
FOR IBN=0:0
SET IBN=$ORDER(^IB("D",IBDT,IBN))
if 'IBN
QUIT
IF $DATA(^IB(IBN,0))
DO GROSS
if $PIECE(^IB(IBN,0),"^",9)=IBN
DO NET
+5 ;
+6 DO PRINT
WRITE !
+7 GOTO END
+8 ;
GROSS ; -gross count of action types, total charges
+1 ; -^tmp($j,"ib",ibaction type,"gcnt")=count
+2 ; ^tmp($j,"ib",ibaction type,"gtot")=sum of charges
+3 ;
+4 SET IBND=^IB(IBN,0)
+5 SET IBATYP=$SELECT($DATA(^IBE(350.1,+$PIECE(IBND,"^",3),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
SET IBSEQNO=$SELECT($DATA(^IBE(350.1,+$PIECE(IBND,"^",3),0)):$PIECE(^(0),"^",5),1:0)
+6 if '$DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"GCNT"))
SET ^("GCNT")=0
SET ^("GCNT")=^("GCNT")+1
+7 if '$DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"GTOT"))
SET ^("GTOT")=0
SET ^("GTOT")=^("GTOT")+$PIECE(IBND,"^",7)
+8 QUIT
+9 ;
NET ; -net count of new actions that aren't cancelled
+1 ; -^tmp($j,"ib",ibaction type,"ncnt")=net count
+2 ; ^tmp($j,"ib",ibaction type,"ntot")=net total
+3 SET IBLAST=""
SET IBLDT=$ORDER(^IB("APDT",IBN,""))
IF +IBLDT
FOR IBL=0:0
SET IBL=$ORDER(^IB("APDT",IBN,IBLDT,IBL))
if 'IBL
QUIT
SET IBLAST=IBL
+4 if 'IBLAST
QUIT
+5 if '$DATA(^IB(IBLAST,0))
QUIT
+6 SET IBCHRG=$PIECE(^IB(IBLAST,0),"^",7)
SET IBSEQNOL=$SELECT($DATA(^IBE(350.1,$PIECE(^IB(IBLAST,0),"^",3),0)):$PIECE(^(0),"^",5),1:"")
+7 if IBSEQNOL=2
SET IBCHRG=0
+8 if '$DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"NTOT"))
SET ^("NTOT")=0
SET ^("NTOT")=^("NTOT")+(IBCHRG)
+9 if '$DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"NCNT"))
SET ^("NCNT")=0
SET ^("NCNT")=^("NCNT")+$SELECT(IBSEQNOL=2:0,1:1)
+10 QUIT
+11 ;
PRINT ; -output data
+1 SET IBQUIT=0
SET IBPAG=0
SET Y=DT
DO D^DIQ
SET IBHDT=Y
DO HDR
+2 WRITE !!?((IOM-25)/2),"NET TOTALS BY ACTION TYPE"
+3 FOR IBSEQNO=0:0
SET IBSEQNO=$ORDER(^TMP($JOB,"IB",IBSEQNO))
if 'IBSEQNO!(IBQUIT)
QUIT
SET IBATYP=""
FOR IBT=0:0
SET IBATYP=$ORDER(^TMP($JOB,"IB",IBSEQNO,IBATYP))
if IBATYP=""!(IBQUIT)
QUIT
DO NETLIN
+4 ;
+5 WRITE !!?((IOM-27)/2),"GROSS TOTALS BY ACTION TYPE"
+6 FOR IBSEQNO=0:0
SET IBSEQNO=$ORDER(^TMP($JOB,"IB",IBSEQNO))
if 'IBSEQNO!(IBQUIT)
QUIT
SET IBATYP=""
FOR IBT=0:0
SET IBATYP=$ORDER(^TMP($JOB,"IB",IBSEQNO,IBATYP))
if IBATYP=""!(IBQUIT)
QUIT
DO LINE
+7 QUIT
+8 ;
LINE ;
+1 IF $Y>(IOSL-5)
DO PAUSE^IBOUTL
if IBQUIT
QUIT
DO HDR
+2 WRITE !!?((IOM/2)-$LENGTH($PIECE(IBATYP," ",2,99))),$PIECE(IBATYP," ",2,99)
+3 WRITE !?((IOM/2)-12),"NUMBER ENTRIES: ",$SELECT($DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"GCNT")):^("GCNT"),1:0)
+4 WRITE !?((IOM/2)-12),"DOLLAR AMOUNT: $",$SELECT($DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"GTOT")):^("GTOT"),1:0)
+5 QUIT
+6 ;
NETLIN ;
+1 IF $Y>(IOSL-5)
DO PAUSE^IBOUTL
if IBQUIT
QUIT
DO HDR
+2 if '$DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"NCNT"))
QUIT
+3 WRITE !!?((IOM/2)-$LENGTH($PIECE(IBATYP," ",2,99))),$PIECE(IBATYP," ",2,99)
+4 WRITE !?((IOM/2)-12),"NUMBER ENTRIES: ",$SELECT($DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"NCNT")):^("NCNT"),1:0)
+5 WRITE !?((IOM/2)-12),"DOLLAR AMOUNT: $",$SELECT($DATA(^TMP($JOB,"IB",IBSEQNO,IBATYP,"NTOT")):^("NTOT"),1:0)
+6 QUIT
HDR ;
+1 if $EXTRACT(IOST,1,2)["C-"!(IBPAG>0)
WRITE @IOF,*13
+2 WRITE ?((IOM-37)/2),"INTEGRATED BILLING STATISTICAL REPORT"
+3 WRITE !?((IOM-3)/2),"for"
+4 DO SITE^IBAUTL
SET IBSNM=$SELECT($DATA(^DIC(4,IBFAC,0)):$PIECE(^(0),"^"),1:"")
+5 WRITE !?((IOM-($LENGTH(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
+6 WRITE !!?(IOM-18/2),"From: "
SET Y=IBBDT
DO DT^DIQ
+7 WRITE !?((IOM-16)/2),"To: "
SET Y=IBEDT
DO DT^DIQ
+8 WRITE !!?(IOM-26/2),"Date Printed: ",IBHDT
+9 SET IBPAG=IBPAG+1
WRITE !?(IOM-8/2),"Page: ",IBPAG
+10 WRITE !?(IOM-26/2),"--------------------------"
+11 QUIT
+12 ;
END KILL ^TMP($JOB)
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOST" D T1^%ZOSV ;stop rt clock
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+4 KILL DUOUT,IBT,IBBDT,IBEDT,IBATYP,IBSEQNO,IBHDT,IBPAG,IBSNM,IBFAC,IBSITE,IBSEQNOL,IBLAST,IBL,IBCHRG,IBDT,IBJ,IBLDT,IBN,IBND,IBQUIT,X,Y
+5 DO ^%ZISC
+6 QUIT
