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

IBCOIVM1.m

Go to the documentation of this file.
  1. IBCOIVM1 ;ALB/NLR - IB BILLING ACTIVITY (COMPILE/PRINT) ;02-MAY-94
  1. ;;2.0;INTEGRATED BILLING;**6,51**;21-MAR-94
  1. ;
  1. LOOP ; get patient from File 354 AIVM X-ref. If still has IVM-identified
  1. ; insurance, and bills against IVM-identified policies, put in report.
  1. ;
  1. K ^TMP("IBOIVM",$J)
  1. S DFN=0 F S DFN=$O(^IBA(354,"AIVM",DFN)) Q:'DFN I $$GETIVM(DFN) D
  1. .S IBNA=$P($$PT^IBEFUNC(DFN),"^",1,2)
  1. .S (IBF,IBIFN)=0 F S IBIFN=$O(^DGCR(399,"C",DFN,IBIFN)) Q:'IBIFN I $D(^DGCR(399,IBIFN,0)),$$HOWID^IBRFN2(IBIFN)=3,$P($G(^DGCR(399,IBIFN,"S")),"^",12),$P($G(^("S")),"^",17)="" S IBF=1 S ^TMP("IBOIVM",$J,IBNA,IBIFN)=""
  1. .I 'IBF S ^TMP("IBOIVM",$J,IBNA,0)=""
  1. ;
  1. ; - print out the report
  1. S (IBAB,IBAC,IBQ,IBPAG)=0 D HDR
  1. I '$D(^TMP("IBOIVM",$J)) W !!?25,"<< NO PATIENTS WITH POLICIES IDENTIFIED BY IVM >>",! G SEND
  1. S IBNA="" F S IBNA=$O(^TMP("IBOIVM",$J,IBNA)) Q:IBNA=""!(IBQ) D
  1. .W ! I $Y>(IOSL-5) D PAUSE Q:IBQ D HDR W !
  1. .W !?1,$E($P(IBNA,"^"),1,25),?27,$E($P(IBNA,"^",2),1,12)
  1. .I $D(^TMP("IBOIVM",$J,IBNA,0)) W ?51,"<< BILLS NOT YET GENERATED AGAINST IVM POLICIES >>" Q
  1. .S (IBF,IBIFN)=0 F S IBIFN=$O(^TMP("IBOIVM",$J,IBNA,IBIFN)) Q:'IBIFN!(IBQ) D
  1. ..I $Y>(IOSL-5),IBF D PAUSE Q:IBQ D HDR W !!?1,$E($P(IBNA,"^"),1,25),?27,$E($P(IBNA,"^",2),1,14) S IBF=0
  1. ..F IBI=0,"S","U" S IBND(IBI)=$G(^DGCR(399,IBIFN,IBI))
  1. ..W:IBF !
  1. ..W ?41,$P(IBND(0),"^")
  1. ..W ?51,$S($$CLO^PRCAFN(IBIFN)>0:"*",1:"")
  1. ..W ?57,$$BTYP(IBIFN,IBND(0))
  1. ..W ?62,$$DAT1^IBOUTL(+IBND("U")),?76,$$DAT1^IBOUTL($P(IBND("U"),"^",2))
  1. ..W ?87,$$DAT1^IBOUTL($P(IBND("S"),"^",12))
  1. ..S IBX=$$ORI^PRCAFN(IBIFN),IBAB=IBAB+IBX
  1. ..W ?105,$J(IBX,8,2)
  1. ..S IBX=$$TPR^PRCAFN(IBIFN),IBAC=IBAC+IBX
  1. ..W ?121,$J(IBX,8,2)
  1. ..S IBF=1
  1. ;
  1. G:IBQ ENQ
  1. ;
  1. ; - print total amounts billed and collected
  1. I $Y>(IOSL-7) D PAUSE G:IBQ ENQ D HDR
  1. I 'IBAB,'IBAC G SEND
  1. W !,?102,"___________",?118,"___________"
  1. W !!,?63,"Total Amounts Billed and Collected:" S X=IBAB,X2="2$",X3=16 D COMMA^%DTC W ?95,X S X=IBAC,X2="2$",X3=16 D COMMA^%DTC W ?111,X
  1. SEND D PAUSE
  1. ;
  1. ; - send report to the IVM Center if necessary
  1. I IBFLG W:$E(IOST,1,2)="C-" !!,"Sending the report in a bulletin to the IVM Center... " D ^IBCOIVM2 W:$E(IOST,1,2)="C-" "done."
  1. ;
  1. ENQ K ^TMP("IBOIVM",$J)
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. K IBFID,IBNA,IBIFN,IBF,IBX,DFN,IBAB,IBAC
  1. K DIR,DIRUT,DUOUT,DTOUT,DIROUT
  1. K IBQ,IBPAG,IBND,IBINS,X,X2,X3,Y
  1. ENQ1 Q
  1. ;
  1. ;
  1. GETIVM(DFN) ; does patient still have IVM-identified insurance?
  1. ; input = dfn
  1. ; output = 0 if no ivm-identified insurance
  1. ; 1 if ivm-identified insurance
  1. ;
  1. N IBINS,X,IBFID
  1. D ALL^IBCNS1(DFN,"IBINS",0)
  1. S IBFID=0 I $G(IBINS(0)) S X=0 F S X=$O(IBINS(X)) Q:'X I $P($G(IBINS(X,1)),"^",9)=3 S IBFID=1 Q
  1. Q IBFID
  1. ;
  1. BTYP(BN,X) ; Determine bill type
  1. ; Input: BN -- Pointer to the bill in file #399
  1. ; X -- Zeroth node of pointed-to bill entry
  1. ; Output: Bill Type --> R: Pharmacy Refill
  1. ; P: Prosthetics
  1. ; I: Inpatient
  1. ; O: Outpatient
  1. N Y,Z
  1. I $G(X)=""!($G(BN)="") S Y="" G BTYPQ
  1. I $D(^IBA(362.4,"AIFN"_BN)) S Y="R" G BTYPQ
  1. I $D(^IBA(362.5,"AIFN"_BN)) S Y="P" G BTYPQ
  1. S Z=$P(X,"^",5),Y=$S(Z=1!(Z=2):"I",1:"O")
  1. BTYPQ Q Y
  1. ;
  1. PAUSE ; Pause for screen output.
  1. Q:$E(IOST,1,2)'="C-"
  1. N IBI,DIR,DIRUT,DIROUT,DUOUT,DTOUT
  1. F IBI=$Y:1:(IOSL-3) W !
  1. S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
  1. Q
  1. ;
  1. HDR ; Display report header.
  1. N X,Y
  1. S X="IVM BILLING ACTIVITY"
  1. S Y=$$SITE^VASITE
  1. I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
  1. S IBPAG=IBPAG+1
  1. W $J("",56),"IVM BILLING ACTIVITY",!
  1. W !,"Facility: ",$P(Y,"^",2)," (",$P(Y,"^",3),")",?101,"Run Date: ",$$DAT1^IBOUTL(DT)," ","Page: ",IBPAG
  1. W !,"Types ==> I:Inpatient, O:Outpatient, P:Prosthetics, R:Pharmacy Refill",?80,"Note: '*' after the Bill # denotes a closed bill"
  1. W !!,$$DASH,!,?55,"Bill",?89,"Date",?107,"Amt",?125,"Amt"
  1. W !,?5,"Patient Name",?32,"SSN",?40,"Bill #",?55,"Type",?62,"Bill From",?75,"-",?79,"To",?86,"Generated",?105,"Billed",?122,"Collected",!,$$DASH
  1. Q
  1. ;
  1. DASH() ; Write dashed line.
  1. Q $TR($J("",131)," ","=")