- 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
- 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
