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

IBCNSMR.m

Go to the documentation of this file.
  1. IBCNSMR ;ALB/AAS - MEDICARE BILLS ; 02-SEPT-97
  1. ;;2.0;INTEGRATED BILLING;**92,240**;21-MAR-94
  1. ;
  1. % G RPRT^IBCNSMRA
  1. ;
  1. DQ ; -- entry point from task manager
  1. N I,J,X,Y,IBINSCO,INSCO,NODE,CNT,IBI,IBINSNM,IBNM
  1. S IBQUIT=0
  1. K ^TMP("IB-MRA",$J),^TMP("IB-MRA-CNT",$J)
  1. ;
  1. S I=0
  1. F S I=$O(^IBE(350.9,1,99,I)) Q:'I S INSCO(+$G(^IBE(350.9,1,99,I,0)))=""
  1. ;
  1. S IBI=0
  1. F S IBI=$O(^DGCR(399,IBI)) Q:'IBI!(IBQUIT) D
  1. .S IBQUIT=$$STOP Q:IBQUIT
  1. .S IBINSCO="" K NODE
  1. .S NODE(0)=$G(^DGCR(399,IBI,0)) Q:NODE(0)=""
  1. .S NODE("C")=$G(^DGCR(399,IBI,"C"))
  1. .S NODE("M")=$G(^DGCR(399,IBI,"M")) Q:NODE("M")=""
  1. .S NODE("U")=$G(^DGCR(399,IBI,"U")) Q:NODE("U")=""
  1. .I $D(INSCO(+NODE("M"))) S IBINSCO=+NODE("M")
  1. .I 'IBINSCO,$D(INSCO(+$P(NODE("M"),"^",2))) S IBINSCO=$P(NODE("M"),"^",2)
  1. .I 'IBINSCO,$D(INSCO(+$P(NODE("M"),"^",3))) S IBINSCO=$P(NODE("M"),"^",3)
  1. .I IBINSCO S IBINSNM=$P($G(^DIC(36,IBINSCO,0)),"^") D BLDDATA
  1. ;
  1. I 'IBQUIT D PRINT^IBCNSMR0
  1. G END^IBCNSMRA
  1. END Q
  1. ;
  1. BLDDATA ; -- for each bill sent to a selected ins. co. build temp node
  1. N X,YEAR,TYPE,TYPENO,PROC,DIAG,ORGAMNT,BOTH,IBSTAT,DFN,ALIVE,ARSTAT,IBQUIT,RXBILL,PROSBILL,BILLNO,LOCCARE,RATETYP,RN,WHO,TIMEFRM,TOTPAID,REFGC,DATEPR
  1. S IBQUIT=0
  1. S BILLNO=$P(NODE(0),"^")
  1. S YEAR=$E(+NODE("U"),2,3)
  1. S TYPENO=$P(NODE(0),"^",5)
  1. S TYPE=$S(TYPENO<3:"INPATIENT",1:"OUTPATIENT")
  1. S PROC=$$PROC(IBI)
  1. S DIAG=$$DIAG(IBI)
  1. S IBSTAT=$P(NODE(0),"^",13)
  1. S ARSTAT=$$STA^PRCAFN(IBI)
  1. S DFN=$P(NODE(0),"^",2)
  1. S ALIVE=$S(+$G(^DPT(DFN,.35)):"DEAD",1:"ALIVE")
  1. S ORGAMNT=$$ORI^PRCAFN(IBI)
  1. S LOCCARE=$P(NODE(0),"^",4)
  1. S WHO=$P(NODE(0),"^",11)
  1. S RATETYP=$P(NODE(0),"^",7)
  1. S RN=$P($G(^DGCR(399.3,+RATETYP,0)),"^")
  1. S TIMEFRM=$P(NODE(0),"^",6)
  1. S TOTPAID=$$TPR^PRCAFN(IBI)
  1. S REFGC=$P($G(^PRCA(430,IBI,6)),"^",4)'=""
  1. S DATEPR=$P($G(^DGCR(399,IBI,"S")),"^",12)
  1. S BOTH="NONE"
  1. S RXBILL=0
  1. S PROSBILL=0
  1. I $O(^IBA(362.4,"AIFN"_IBI,"")) S RXBILL=1
  1. I $O(^IBA(362.5,"AIFN"_IBI,"")) S PROSBILL=1
  1. D COUNT
  1. D:'IBQUIT SET
  1. Q
  1. ;
  1. COUNT ; -- set totals for all ins, and by ins co.
  1. S CNT=$G(CNT)+1
  1. S CNT(0)=$G(CNT(0))+ORGAMNT
  1. S CNT(3,IBINSNM)=$G(CNT(3,IBINSNM))+1
  1. S CNT(3,IBINSNM,0)=$G(CNT(3,IBINSNM,0))+ORGAMNT
  1. I TYPE="INPATIENT" D
  1. .S CNT("IN")=$G(CNT("IN"))+1
  1. .S CNT("IN",0)=$G(CNT("IN",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("IN",1)=$G(CNT("IN",1))+1
  1. ..S CNT("IN",2)=$G(CNT("IN",2))+TOTPAID
  1. I TYPE="OUTPATIENT" D
  1. .S CNT("OP")=$G(CNT("OP"))+1
  1. .S CNT("OP",0)=$G(CNT("OP",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("OP",1)=$G(CNT("OP",1))+1
  1. ..S CNT("OP",2)=$G(CNT("OP",2))+TOTPAID
  1. I TOTPAID>0 D
  1. .S CNT(1)=$G(CNT(1))+1
  1. .S CNT(2)=$G(CNT(2))+TOTPAID
  1. .S CNT(3,IBINSNM,1)=$G(CNT(3,IBINSNM,1))+1
  1. .S CNT(3,IBINSNM,2)=$G(CNT(3,IBINSNM,2))+TOTPAID
  1. ;
  1. ;I ALIVE'="ALIVE" D ; decided to keep dead patients in the report 10/28/97
  1. ;.S CNT("A")=$G(CNT("A"))+1
  1. ;.S CNT("A",0)=$G(CNT("A",0))+ORGAMNT
  1. ;.;S IBQUIT=1
  1. ;.I TOTPAID>0 D
  1. ;..S CNT("A",1)=$G(CNT("A",1))+1
  1. ;..S CNT("A",2)=$G(CNT("A",2))+TOTPAID
  1. ;
  1. I DIAG="YES"&(PROC="NO") D
  1. .S BOTH="DIAG"
  1. .S IBQUIT=1
  1. .S CNT("D")=$G(CNT("D"))+1
  1. .S CNT("D",0)=$G(CNT("D",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("D",1)=$G(CNT("D",1))+1
  1. ..S CNT("D",2)=$G(CNT("D",2))+TOTPAID
  1. ;
  1. I PROC="YES"&(DIAG="NO") D
  1. .S BOTH="PROC"
  1. .S IBQUIT=1
  1. .S CNT("P")=$G(CNT("P"))+1
  1. .S CNT("P",0)=$G(CNT("P",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("P",1)=$G(CNT("P",1))+1
  1. ..S CNT("P",2)=$G(CNT("P",2))+TOTPAID
  1. ;
  1. I PROC="YES"&(DIAG="YES") D
  1. .S BOTH="BOTH"
  1. .S CNT("B")=$G(CNT("B"))+1
  1. .S CNT("B",0)=$G(CNT("B",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("B",1)=$G(CNT("B",1))+1
  1. ..S CNT("B",2)=$G(CNT("B",2))+TOTPAID
  1. ;
  1. I BOTH="NONE" D
  1. .S CNT("N")=$G(CNT("N"))+1
  1. .S CNT("N",0)=$G(CNT("N",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("N",1)=$G(CNT("N",1))+1
  1. ..S CNT("N",2)=$G(CNT("N",2))+TOTPAID
  1. ;
  1. I BOTH'="BOTH" S IBQUIT=1
  1. ;
  1. I IBSTAT=7,+ARSTAT=210 D ;bill canceled before completion
  1. .S CNT("C")=$G(CNT("C"))+1
  1. .S CNT("C",0)=$G(CNT("C",0))+ORGAMNT
  1. .S IBQUIT=1
  1. .I TOTPAID>0 D
  1. ..S CNT("C",1)=$G(CNT("C",1))+1
  1. ..S CNT("C",2)=$G(CNT("C",2))+TOTPAID
  1. ;
  1. I TYPENO=2!(TYPENO=4) D
  1. .S CNT("T")=$G(CNT("T"))+1
  1. .S CNT("T",0)=$G(CNT("T",0))+ORGAMNT
  1. .S IBQUIT=1
  1. .I TOTPAID>0 D
  1. ..S CNT("T",1)=$G(CNT("T",1))+1
  1. ..S CNT("T",2)=$G(CNT("T",2))+TOTPAID
  1. ;
  1. I WHO'="i" D
  1. .S CNT("W")=$G(CNT("W"))+1
  1. .S CNT("W",0)=$G(CNT("W",0))+ORGAMNT
  1. .S IBQUIT=1
  1. .I TOTPAID>0 D
  1. ..S CNT("W",1)=$G(CNT("W",1))+1
  1. ..S CNT("W",2)=$G(CNT("W",2))+TOTPAID
  1. ;
  1. I DATEPR="",IBSTAT<3 D
  1. .S CNT("F")=$G(CNT("F"))+1
  1. .S CNT("F",0)=$G(CNT("F",0))+ORGAMNT
  1. .S IBQUIT=1
  1. .I TOTPAID>0 D
  1. ..S CNT("F",1)=$G(CNT("F",1))+1
  1. ..S CNT("F",2)=$G(CNT("F",2))+TOTPAID
  1. ;
  1. I $G(RXBILL) D
  1. .S CNT("X")=$G(CNT("X"))+1
  1. .S CNT("X",0)=$G(CNT("X",0))+ORGAMNT
  1. .S IBQUIT=1
  1. .I TOTPAID>0 D
  1. ..S CNT("X",1)=$G(CNT("X",1))+1
  1. ..S CNT("X",2)=$G(CNT("X",2))+TOTPAID
  1. ;
  1. I $G(PROSBILL) D
  1. .S CNT("Z")=$G(CNT("Z"))+1
  1. .S CNT("Z",0)=$G(CNT("Z",0))+ORGAMNT
  1. .S IBQUIT=1
  1. .I TOTPAID>0 D
  1. ..S CNT("Z",1)=$G(CNT("Z",1))+1
  1. ..S CNT("Z",2)=$G(CNT("Z",2))+TOTPAID
  1. ;
  1. I $S(RN["MEANS":1,RN["DENTAL":1,RN["TORT":1,RN["TRICARE":1,RN["CHAMPVA":1,RN["MEDICARE":1,RN["WORKERS":1,RN["CRIME":1,RN["SHARING":1,1:0) D
  1. .S CNT("R")=$G(CNT("R"))+1
  1. .S CNT("R",0)=$G(CNT("R",0))+ORGAMNT
  1. .S IBQUIT=1
  1. .I TOTPAID>0 D
  1. ..S CNT("R",1)=$G(CNT("R",1))+1
  1. ..S CNT("R",2)=$G(CNT("R",2))+TOTPAID
  1. Q
  1. ;
  1. PROC(IBI) ; -- does bill have any procedures
  1. N PROC
  1. S PROC="NO"
  1. I $O(^DGCR(399,IBI,"CP",0)) S PROC="YES"
  1. I +NODE("C")!($P(NODE("C"),"^",4))!($P(NODE("C"),"^",7)) S PROC="YES"
  1. Q PROC
  1. ;
  1. DIAG(IBI) ; -- does bill have any diagnosis
  1. N DIAG
  1. S DIAG="NO"
  1. I $O(^IBA(362.3,"AIFN"_IBI,0)) S DIAG="YES"
  1. I $P(NODE("C"),"^",10)!($P(NODE("C"),"^",14)) S DIAG="YES"
  1. Q DIAG
  1. ;
  1. SET ; -- set up tmp global
  1. S CNT("M")=$G(CNT("M"))+1,CNT("M",0)=$G(CNT("M",0))+ORGAMNT
  1. I REFGC D
  1. .S CNT("M",4)=$G(CNT("M",4))+1
  1. .S CNT("M",5)=$G(CNT("M",5))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("M",6)=$G(CNT("M",6))+1
  1. ..S CNT("M",7)=$G(CNT("M",7))+TOTPAID
  1. I TOTPAID>0 D
  1. .S CNT("M",1)=$G(CNT("M",1))+1
  1. .S CNT("M",2)=$G(CNT("M",2))+TOTPAID
  1. I TYPE="INPATIENT" D
  1. .S CNT("M","IN")=$G(CNT("M","IN"))+1
  1. .S CNT("M","IN",0)=$G(CNT("M","IN",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("M","IN",1)=$G(CNT("M","IN",1))+1
  1. ..S CNT("M","IN",2)=$G(CNT("M","IN",2))+TOTPAID
  1. I TYPE="OUTPATIENT" D
  1. .S CNT("M","OP")=$G(CNT("M","OP"))+1
  1. .S CNT("M","OP",0)=$G(CNT("M","OP",0))+ORGAMNT
  1. .I TOTPAID>0 D
  1. ..S CNT("M","OP",1)=$G(CNT("M","OP",1))+1
  1. ..S CNT("M","OP",2)=$G(CNT("M","OP",2))+TOTPAID
  1. ;
  1. S ^TMP("IB-MRA",$J,+$G(IBINSCO),+$G(YEAR),$G(TYPE,"UNKNOWN"),BOTH,$G(ARSTAT,"UNKNOWN"),+$G(IBSTAT),IBI)=BILLNO_"^"_DFN
  1. ;
  1. S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT)=(+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT))+1)
  1. ;
  1. S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,0)=+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,0))+ORGAMNT
  1. ;
  1. I TOTPAID>0 D
  1. .S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,1)=+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,1))+1
  1. .S ^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,2)=+$G(^TMP("IB-MRA-CNT",$J,IBINSCO,YEAR,TYPE,BOTH,ARSTAT,IBSTAT,2))+TOTPAID
  1. Q
  1. ;
  1. STOP() ; -- determine if user requested task to stop
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ
  1. Q +$G(ZTSTOP)