Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTOSUM2

IBTOSUM2.m

Go to the documentation of this file. 
  1. IBTOSUM2	;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 29-OCT-93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;
  1. PRINT	; -- print the report
  1. 	K X,X2,X3
  1. 	D HDR,MAIN
  1. 	D PENAL
  1. 	I $O(IBCNT(3,0)) D RNB
  1. 	I $O(IBCNT(10,0)) D APPROV
  1. 	I $O(IBCNT(20,0)) D DENIAL
  1. 	Q
  1. 	;
  1. MAIN	; -- print main body of report
  1. 	W !?((IOM/2)-16),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges"),": ",$J(IBCNT(1),11)
  1. 	W !?((IOM/2)-31),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," with Insurance: ",$J(IBCNT(2),11)
  1. 	W !?((IOM/2)-25),"Total Billable ",$S(IBSORT="A":"Admissions",1:"Discharges"),": ",$J(+$G(IBCNT(3,0)),11)
  1. 	;
  1. 	W !?((IOM/2)-34),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Requiring Reviews: ",$J(IBCNT(4),11)
  1. 	W !?((IOM/2)-25),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed: ",$J(IBCNT(99),11)
  1. 	W !?((IOM/2)-40),"Total ",$S(IBSORT="A":"Admissions",1:"Discharges")," Reviewed, Multi Carrier: ",$J(IBCNT(13),11)
  1. 	;
  1. 	I $E(IOST,1,2)="C-" W ! D PAUSE^VALM1 Q:$D(DIRUT)  W @IOF
  1. 	;
  1. 	W !!?((IOM/2)-18),"Total Reviews Done: ",$J(IBCNT(5),11)
  1. 	W !?((IOM/2)-23),"Number of Days Approved: ",$J(IBCNT(10),11)
  1. 	S X=IBCNT(11),X2="0$" D COMMA^%DTC
  1. 	W !?((IOM/2)-39),"Amount Collectible Approved for Billing: ",X
  1. 	;
  1. 	W !!?((IOM/2)-21),"Number of Days Denied: ",$J(IBCNT(20),11)
  1. 	S X=IBCNT(21),X2="0$" D COMMA^%DTC
  1. 	W !?((IOM/2)-25),"Amount Denied for Billing: ",X
  1. 	;
  1. 	W !!?((IOM/2)-20),"Total Cases Appealed: ",$J(IBCNT(80),11)
  1. 	W !?((IOM/2)-25),"Number of Initial Appeals: ",$J(IBCNT(81),11)
  1. 	W !?((IOM/2)-28),"Number of Subsequent Appeals: ",$J(IBCNT(82),11)
  1. 	;
  1. 	Q
  1. 	;
  1. PENAL	; -- penalty codes; variable; external form
  1. 	;   1; IBCNT(31);  NO PRE ADMISSION CERTIFICATION
  1. 	;   2; IBCNT(32);  UNTIMELY PRE ADMISSION CERTIFICATION
  1. 	;   3; IBCNT(33);  VA A NON-PROVIDER
  1. 	;
  1. 	W !!!?((IOM/2)-14),"Penalty Report:  Number of cases              Dollars"
  1. 	W !?((IOM/2)-14),"---------------  ------------------------------------"
  1. 	W !?((IOM/2)-30),"No Pre Admission Certification: ",$J($P(IBCNT(31),"^"),10),"                   " S X=+$P(IBCNT(31),"^",2),X3=9,X2="0$" D COMMA^%DTC W X
  1. 	W !?((IOM/2)-36),"Untimely Pre Admission Certification: ",$J($P(IBCNT(32),"^"),10),"                   " S X=+$P(IBCNT(32),"^",2),X3=9,X2="0$" D COMMA^%DTC W X
  1. 	W !?((IOM/2)-17),"VA a Non-Provider: ",$J($P(IBCNT(33),"^"),10),"                   " S X=+$P(IBCNT(33),"^",2),X3=9,X2="0$" D COMMA^%DTC W X
  1. 	Q
  1. 	;
  1. RNB	; -- print reasons not billable
  1. 	D CNT(3)
  1. 	W !!!?((IOM/2)-26),"Reason Not Billable Report:  Reason                         Count"
  1. 	W !?((IOM/2)-26),"---------------------------  ------------------------------------"
  1. 	S I=0 F  S I=$O(IBCNT(3,I)) Q:'I  D
  1. 	.W !?((IOM/2)+3),$E($P($G(^IBE(356.8,+I,0)),"^")_"               ",1,27)
  1. 	.W ?((IOM/2)+30)," ",$J(IBCNT(3,I),8)
  1. 	Q
  1. 	;
  1. 	;
  1. DENIAL	; -- print days denied by specialty
  1. 	D CNT(20)
  1. 	W !!!?((IOM/2)-24),"Days Denied by Specialty:  Specialty         No. Days   Dollars"
  1. 	W !?((IOM/2)-24),"-------------------------  ------------------------------------"
  1. 	S I=0 F  S I=$O(IBCNT(20,I)) Q:'I  D
  1. 	.W !?((IOM/2)+3),$E($P($G(^DIC(45.7,+I,0)),"^")_"       ",1,16)
  1. 	.W ?((IOM/2)+20)," ",$J(IBCNT(20,I),6)
  1. 	.S X=IBCNT(21,I),X2="0$" D COMMA^%DTC
  1. 	.W ?((IOM/2)+30)," ",X
  1. 	Q
  1. 	;
  1. 	;
  1. APPROV	; -- print days approved by specialty
  1. 	D CNT(10)
  1. 	W !!!?((IOM/2)-26),"Days Approved by Specialty:  Specialty         No. Days   Dollars"
  1. 	W !?((IOM/2)-26),"---------------------------  ------------------------------------"
  1. 	S I=0 F  S I=$O(IBCNT(10,I)) Q:'I  D
  1. 	.W !?((IOM/2)+3),$E($P($G(^DIC(45.7,+I,0)),"^")_"       ",1,16)
  1. 	.W ?((IOM/2)+20)," ",$J(IBCNT(10,I),6)
  1. 	.S X=IBCNT(11,I),X2="0$" D COMMA^%DTC
  1. 	.W ?((IOM/2)+30)," ",X
  1. 	;
  1. 	Q
  1. 	;
  1. HDR	; -- print report header
  1. 	W:$E(IOST,1,2)["C-"!(IBPAG>0) @IOF
  1. 	W !?((IOM-22)/2),"MCCR/UR SUMMARY REPORT"
  1. 	W !?((IOM-3)/2),"for"
  1. 	D SITE^IBAUTL S IBSNM=$S($D(^DIC(4,IBFAC,0)):$P(^(0),"^"),1:"")
  1. 	W !?((IOM-($L(IBSNM)+6))/2),IBSNM_" ("_IBSITE_")"
  1. 	W !!?((IOM-14)/2),"for "_$S(IBSORT="A":"Admissions",1:"Discharges")
  1. 	W !?(IOM-18/2),"From: " S Y=IBBDT D DT^DIQ
  1. 	W !?((IOM-16)/2)," To: " S Y=IBEDT D DT^DIQ
  1. 	W !!?(IOM-26/2),"Date Printed: ",IBHDT
  1. 	S IBPAG=IBPAG+1 W !?(IOM-8/2),"Page: ",IBPAG
  1. 	W !?(IOM-26/2),"--------------------------",!!
  1. 	Q
  1. 	;
  1. CHK	; -- check task man stop flag
  1. 	I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 D HDR W !!,"....task stopped at user request."
  1. 	Q
  1. 	;
  1. CNT(N)	; -- see if enought room on page for list
  1. 	Q:'$G(N)
  1. 	S (IBC,I)=0 F  S I=$O(IBCNT(N,I)) Q:'I  S IBC=IBC+1
  1. 	I IOSL<($Y+IBC+3),$E(IOST,1,2)="C-" D PAUSE^VALM1 S:$D(DIRUT) IBQUIT=1 W:'IBQUIT @IOF Q
  1. 	I IOSL<($Y+IBC+3) D HDR
  1. 	Q