- 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 Feb 18, 2025@23:44:37 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)," ","=")