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