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

IBOSTUS1.m

Go to the documentation of this file.
  1. IBOSTUS1 ;ALB/SGD-MCCR BILL STATUS REPORT ;25 MAY 88 14:19
  1. ;;2.0;INTEGRATED BILLING;**31,118,128,153,137,161,183,155**;21-MAR-94
  1. ;
  1. ;MAP TO DGCROST1
  1. ;
  1. EN ; - Entry point from IBOSTUS.
  1. N IBSUB,IBHDR,IBST1,IBST2,IBCAT,IBAMT,IBBEF,IBCRT,IBQUIT,IBMTCT,DFN,REJFLG
  1. S IBBEF="",IBQUIT=0,IBCRT=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. I IBDTP="Entered" S IBSUB="APD",IBHDR=1
  1. I IBDTP="Bill" S IBSUB="AP",IBHDR=1
  1. I IBDTP="Event" S IBSUB="D",IBHDR=0
  1. I IBDTP="MRA Request" S IBSUB="APM",IBHDR=0
  1. I 'IBSUM D HEAD
  1. ;
  1. PROC ; - Get data for report(s).
  1. S X1=IBBEG\1,X2=-1 D C^%DTC S IBNEX=X_.2359,X=132 X ^%ZOSF("RM")
  1. F S IBNEX=$O(^DGCR(399,IBSUB,IBNEX)) Q:'IBNEX!(IBNEX>(IBEND\1_.2359))!(IBQUIT) D Q:IBQUIT
  1. .I $Y>$S($D(IOSL):(IOSL-$S(IBCRT:4,1:9)),1:20) D HEAD Q:IBQUIT
  1. .I IBHDR,'IBSUM D SUBHDR
  1. .S IBIFN="" F J=0:0 S IBIFN=$O(^DGCR(399,IBSUB,IBNEX,IBIFN)) Q:'IBIFN!IBQUIT D SET S IBBEF=IBNEX
  1. I 'IBQUIT D
  1. .I '$D(IBF) W !!,?10,"*** No matches found ***"
  1. .E D SUM^IBOSTUS
  1. ;
  1. Q I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. SET ; This section is called for a single bill - IBIFN
  1. S IBS=$G(^DGCR(399,IBIFN,"S")),IBAPP=1
  1. I $P(IBS,U,17)'="" S IBBS=" CANCELLED",IBBSDT=$P(IBS,U,17),IBBSBY=$P(IBS,U,18) D:IBBST="C" PRINT G ALL
  1. I $P(IBS,U,14)'="" S IBBS=" PRNT/TXMT",IBBSDT=$P(IBS,U,12),IBBSBY=$P(IBS,U,13) D:IBBST="P" PRINT G ALL
  1. I $P(IBS,U,10)'="" S IBBS="* AUTHORIZED",IBAPP=$P(IBS,U,9),IBBSDT=$P(IBS,U,10),IBBSBY=$P(IBS,U,11) D:IBBST="A" PRINT G ALL
  1. I $P(IBS,U,7)'="" S IBBS="* REQUEST MRA",IBBSDT=$P(IBS,U,7),IBBSBY=$P(IBS,U,8) D:IBBST="R" G ALL
  1. . ; if user answered No to 'print Bills with No MRA Received and No Rejection messages', print report as usual
  1. . I 'IBNOEOB D PRINT Q
  1. . ; if user answered Yes (IBNOEOB=1), check two things before printing:
  1. . ; 1) if MRA on file, don't print
  1. . I $$CHK^IBCEMU1(IBIFN) Q
  1. . ; 2) if the most recent transmission for this claim was rejected, don't print
  1. . D TXSTS^IBCEMU2(IBIFN,,.REJFLG)
  1. . I REJFLG Q
  1. . ;
  1. . ; otherwise, print bill
  1. . D PRINT
  1. ;
  1. S IBBS="* ENTERED",IBBSDT=$P(IBS,U),IBBSBY=$P(IBS,U,2) D:IBBST="E" PRINT
  1. ALL Q:IBQUIT I IBBST="ALL" D PRINT
  1. Q
  1. ;
  1. PRINT ; - Print detail report, if necessary.
  1. NEW LINE
  1. I $Y>$S($D(IOSL):(IOSL-$S(IBCRT:4,1:6)),1:6) D HEAD Q:IBQUIT D SUBHDR:(IBBEF=IBNEX)&IBHDR
  1. S IBF=1,IB0=$G(^DGCR(399,IBIFN,0))
  1. S IBCAT=$S($D(^DGCR(399.3,+$P(IB0,U,7),0)):$P(^(0),U,4),1:"UNSPECIFIED")_$S($P(IB0,U,5)>2:"-OPT",1:"-INPT")
  1. S IBU1=$G(^DGCR(399,IBIFN,"U1")),IBAMT=$S(IBU1="":0,$P(IBU1,U,2)]"":$P(IBU1,U)-$P(IBU1,U,2),1:$P(IBU1,U))
  1. I IBSUM D ADD Q ; Printing summary ONLY.
  1. ;
  1. S DFN=$P(IB0,U,2) D PID^VADPT6 W !,$P(IB0,U),?10,$E($P(^DPT($P(IB0,U,2),0),U),1,20),?31,VA("BID"),?39,$E($P(IB0,U,3),4,5),"/",$E($P(IB0,U,3),6,7),"/",$E($P(IB0,U,3),2,3)
  1. S IBBY=$P(IBS,U,2) W:IBBY ?50,$E($S($D(^VA(200,IBBY,0)):$P(^(0),U,2),1:"UNKN"),1,4) W ?57,IBCAT
  1. ;
  1. ; - MT status as of event date.
  1. S IBMTCT=$P($$LST^DGMTU(DFN,$P(IB0,U,3)),U,4)
  1. S IBMTCT=$S(IBMTCT="C":"YES",IBMTCT="P":"PEN",IBMTCT="R":"REQ",IBMTCT="G":"GMT",1:"NO")
  1. W ?72,IBMTCT
  1. ;
  1. S X=IBAMT,X2="2$" D COMMA^%DTC W ?77,$J(X,10)
  1. W ?90,IBBS,$S('IBAPP:"/DISAPP",1:"")," ",$E(IBBSDT,4,5),"/",$E(IBBSDT,6,7),"/",$E(IBBSDT,2,3)," (",$S($D(^VA(200,+IBBSBY,0)):$P(^(0),U,2),1:"UNKN USER"),"/",IBBSBY,")" K VA("BID"),VA("PID")
  1. ;
  1. ; If the user chose to print the ClaimsManager comments, then show
  1. ; them all here. Also do the appropriate $Y checks for the next page.
  1. ;
  1. I 'IBCICOMM G SKPCMM ; user doesn't want comments
  1. I '$D(^IBA(351.9,IBIFN,2)) G SKPCMM ; no comments exist
  1. ;
  1. W !!?8,$$CMTINFO^IBCIUT5(IBIFN)
  1. S LINE=0
  1. F S LINE=$O(^IBA(351.9,IBIFN,2,LINE)) Q:'LINE D Q:IBQUIT
  1. . I $Y>(IOSL-$S(IBCRT:4,1:6)) D HEAD Q:IBQUIT
  1. . W !?10,$G(^IBA(351.9,IBIFN,2,LINE,0))
  1. . Q
  1. Q:IBQUIT
  1. W !
  1. ;
  1. SKPCMM ; skip to here if we're not printing ClaimsManager comments
  1. ;
  1. D ADD
  1. Q
  1. ;
  1. I $G(IBPAGE)>0,IBCRT S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1 Q
  1. S IBPAGE=$G(IBPAGE)+1,$P(IBL,"=",IOM)="",Y=IBBEG X ^DD("DD")
  1. W @IOF,!,"MCCR Bill Status ",$S(IBSUM:"Statistics",1:"Report")," for ",$S(IBBEG'=IBEND:"period covering ",1:"")_Y
  1. I IBBEG<IBEND S Y=IBEND X ^DD("DD") W " thru "_Y
  1. I '$D(IBRUN) D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S IBRUN=Y
  1. I 'IBSUM W ?100,IBRUN,?123,"Page ",$J(IBPAGE,3)
  1. W ! I $D(IBHD) W "Bill Status: ",IBHD," "
  1. I 'IBSUM W:IBBST'="C"&(IBBST'="P") "* Denotes that the bill status is not Printed or Cancelled" W:IBCICOMM ?106,"ClaimsManager Comments ON"
  1. E W "Run Date: ",IBRUN
  1. ; if user answered Yes to 'No MRA Received and No Rejection messages' question, print this line in header
  1. I IBNOEOB W !,"**** Bills with No MRA Received and No current CSA Rejection messages ****"
  1. I 'IBSUM D
  1. .W !!?39,"EVENT",?49,"ENTRD",?73,"MT",!,"BILL NO.",?10,"PATIENT NAME"
  1. .W ?31,"PT.ID",?39,"DATE",?50,"BY",?57,"RATE TYPE",?70,"STATUS"
  1. .W ?81,"CHARGES",?94,"BILL STATUS"
  1. ;
  1. W !,IBL W:IBSUM ! K IBL
  1. Q
  1. ;
  1. SUBHDR W !!?3,IBDTP_" Date: "_$$DAT1^IBOUTL(IBNEX)
  1. Q
  1. ;
  1. ADD ; - For summary statistics.
  1. S IBST1(IBCAT,"C")=1+$G(IBST1(IBCAT,"C"))
  1. S IBST1(IBCAT,"$")=IBAMT+$G(IBST1(IBCAT,"$"))
  1. S:IBBS["* " IBBS=$P(IBBS,"* ",2)
  1. S:IBBS[" " IBBS=$P(IBBS," ",2)
  1. S:IBBS="" IBBS="UNKNOWN"
  1. S IBST2(IBBS,"C")=1+$G(IBST2(IBBS,"C"))
  1. S IBST2(IBBS,"$")=IBAMT+$G(IBST2(IBBS,"$"))
  1. Q