- IBOTR3 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - OUTPUT ; 5-JUN-91
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- ;MAP TO DGCROTR3
- ;
- S (IBQUIT,IBPAG)=0,IBLINE="",$P(IBLINE,"-",IOM)="",Y=DT D D^DIQ S IBTDT=Y
- I $D(IBAF) D ADDFLD^IBOTR4
- I '$D(^TMP($J,"IBOTR")) D S IBCALC=3 D PAUSE G END
- . S IBX=$S("bB"'[IBBRT:IBBRT,IBBRN="C":"A",1:"I")
- . D HDR W !!," NO INFORMATION MATCHES SELECTION CRITERIA."
- ;
- S IBX="" F S IBX=$O(^TMP($J,"IBOTR",IBX)) Q:IBX="" S IBTT="0^0^0^0" D HDR Q:IBQUIT D INS Q:IBQUIT
- END K ^TMP($J),IBQUIT,IBINS,IBPAG,IBLINE,IBTDT,IBX,IBTT,IBTI,IBCALC,IBBN,IBD,X,X1,X2,IBAFT,IBI
- Q
- ;
- INS ; Loop through each Insurance company.
- S IBINS="" F S IBINS=$O(^TMP($J,"IBOTR",IBX,IBINS)) Q:IBINS="" S IBTI="0^0^0^0" D BILLNO Q:IBQUIT
- D:'IBQUIT GTOT^IBOTR4 ; Write grand totals for Inpt/Outpt report.
- Q
- ;
- BILLNO ; Loop through all bills for an Insurance company.
- I $Y>(IOSL-11) S IBCALC=11 D PAUSE Q:IBQUIT D HDR Q:IBQUIT
- D INSADD S IBBN=""
- F S IBBN=$O(^TMP($J,"IBOTR",IBX,IBINS,IBBN)) Q:IBBN="" S IBD=^(IBBN) D DETAIL Q:IBQUIT
- D:'IBQUIT SUBTOT^IBOTR4 ; Write sub-totals for each insurance company.
- Q
- ;
- DETAIL ; Write out detail lines.
- N IBPEN S IBPEN=$S($P(IBBN,"@@",2)["*":0,1:$P(IBD,"^",6)-$P(IBD,"^",7))
- I $Y>(IOSL-3) S IBCALC=3 D PAUSE Q:IBQUIT D HDR Q:IBQUIT D INSADD
- W !,$P(IBBN,"@@",2),?10,$P(IBBN,"@@"),?34,$$DATE($P(IBD,"^",2)),?44,$$DATE($P(IBD,"^",3))
- W ?54,$$DATE($P(IBD,"^",4)),?64,$$DATE($P(IBD,"^",5))
- S X1=$P(IBD,"^",5),X2=$P(IBD,"^",4) D ^%DTC W ?75,$J(X,4)
- W ?80,$J($P(IBD,"^",6),9,2),?90,$J($P(IBD,"^",7),9,2)
- W ?101,$J($P(IBD,"^",6)-$P(IBD,"^",7),9,2),?111,$J(IBPEN,9,2)
- W ?123,$J($S(+$P(IBD,"^",6)=0:0,1:$P(IBD,"^",7)/$P(IBD,"^",6)*100),6,2)
- S $P(IBTI,"^")=$P(IBTI,"^")+1,$P(IBTI,"^",2)=$P(IBTI,"^",2)+$P(IBD,"^",6),$P(IBTI,"^",3)=$P(IBTI,"^",3)+$P(IBD,"^",7),$P(IBTI,"^",4)=$P(IBTI,"^",4)+IBPEN
- S $P(IBTT,"^")=$P(IBTT,"^")+1,$P(IBTT,"^",2)=$P(IBTT,"^",2)+$P(IBD,"^",6),$P(IBTT,"^",3)=$P(IBTT,"^",3)+$P(IBD,"^",7),$P(IBTT,"^",4)=$P(IBTT,"^",4)+IBPEN
- Q
- ;
- HDR ; Print the report header.
- S IBPAG=IBPAG+1 W:$E(IOST,1,2)["C-"!(IBPAG>1) @IOF W IBRTN," PAYMENT TREND REPORT -- "
- W $S(IBX="I":"INPATIENT",IBX="O":"OUTPATIENT",1:"COMBINED INPATIENT AND OUTPATIENT")," BILLING"
- W ?105,IBTDT," PAGE: ",IBPAG
- W !?6,IBDFN,": ",$$DATE(IBBDT)," - ",$$DATE(IBEDT),?57,"Note: '*' after the Bill Number denotes a CLOSED bill"
- W:$D(IBAF) !?6,IBAFT
- W !,"BILL",?10,"PATIENT",?55,"DATE",?64,"DATE BILL",?76,"#"
- W ?82,"AMOUNT",?91,"AMOUNT",?103,"AMOUNT",?112,"AMOUNT",?122,"PERCENT"
- W !,"NUMBER",?10,"NAME/ (AGE)",?34,"BILL FROM - TO",?54,"PRINTED"
- W ?65,"CLOSED",?75,"DAYS",?82,"BILLED",?90,"COLLECTED",?103,"UNPAID"
- W ?112,"PENDING",?122,"COLLECTED",!,IBLINE
- S IBQUIT=$$STOP^IBOUTL("Trend Report")
- Q
- ;
- DATE(IBX) S:IBX]"" IBX=$E(IBX,4,5)_"/"_$E(IBX,6,7)_"/"_$E(IBX,2,3) Q IBX
- ;
- PAUSE Q:$E(IOST,1,2)'="C-"
- F IBI=$Y:1:(IOSL-IBCALC) W !
- S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
- Q
- ;
- INSADD ; Display Insurance Company name and address. Input: IBINS
- N D,IEN
- W !!?8,"PRIMARY INSURANCE CARRIER: ",$P(IBINS,"@@")
- S IEN=$P(IBINS,"@@",2) G:'IEN INSADDQ
- S D=$G(^DIC(36,IEN,.11)) G:D="" INSADDQ
- W:$P(D,"^")]"" !?36,$P(D,"^")
- W:$P(D,"^",2)]"" !?36,$P(D,"^",2)
- W:$P(D,"^",3)]"" !?36,$P(D,"^",3)
- W:$P(D,"^")]""!($P(D,"^",2)]"")!($P(D,"^",3)]"") !?36
- W $P(D,"^",4) W:$P(D,"^",4)]""&($P(D,"^",5)]"") ", "
- W $P($G(^DIC(5,+$P(D,"^",5),0)),"^")
- W:$P(D,"^",6)]""&($P(D,"^",4)]""!($P(D,"^",5)]"")) " "
- W $P(D,"^",6)
- INSADDQ W ! Q
- IBOTR3 ;ALB/CPM - INSURANCE PAYMENT TREND REPORT - OUTPUT ; 5-JUN-91
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- +3 ;MAP TO DGCROTR3
- +4 ;
- +5 SET (IBQUIT,IBPAG)=0
- SET IBLINE=""
- SET $PIECE(IBLINE,"-",IOM)=""
- SET Y=DT
- DO D^DIQ
- SET IBTDT=Y
- +6 IF $DATA(IBAF)
- DO ADDFLD^IBOTR4
- +7 IF '$DATA(^TMP($JOB,"IBOTR"))
- Begin DoDot:1
- +8 SET IBX=$SELECT("bB"'[IBBRT:IBBRT,IBBRN="C":"A",1:"I")
- +9 DO HDR
- WRITE !!," NO INFORMATION MATCHES SELECTION CRITERIA."
- End DoDot:1
- SET IBCALC=3
- DO PAUSE
- GOTO END
- +10 ;
- +11 SET IBX=""
- FOR
- SET IBX=$ORDER(^TMP($JOB,"IBOTR",IBX))
- IF IBX=""
- QUIT
- SET IBTT="0^0^0^0"
- DO HDR
- IF IBQUIT
- QUIT
- DO INS
- IF IBQUIT
- QUIT
- END KILL ^TMP($JOB),IBQUIT,IBINS,IBPAG,IBLINE,IBTDT,IBX,IBTT,IBTI,IBCALC,IBBN,IBD,X,X1,X2,IBAFT,IBI
- +1 QUIT
- +2 ;
- INS ; Loop through each Insurance company.
- +1 SET IBINS=""
- FOR
- SET IBINS=$ORDER(^TMP($JOB,"IBOTR",IBX,IBINS))
- IF IBINS=""
- QUIT
- SET IBTI="0^0^0^0"
- DO BILLNO
- IF IBQUIT
- QUIT
- +2 ; Write grand totals for Inpt/Outpt report.
- IF 'IBQUIT
- DO GTOT^IBOTR4
- +3 QUIT
- +4 ;
- BILLNO ; Loop through all bills for an Insurance company.
- +1 IF $Y>(IOSL-11)
- SET IBCALC=11
- DO PAUSE
- IF IBQUIT
- QUIT
- DO HDR
- IF IBQUIT
- QUIT
- +2 DO INSADD
- SET IBBN=""
- +3 FOR
- SET IBBN=$ORDER(^TMP($JOB,"IBOTR",IBX,IBINS,IBBN))
- IF IBBN=""
- QUIT
- SET IBD=^(IBBN)
- DO DETAIL
- IF IBQUIT
- QUIT
- +4 ; Write sub-totals for each insurance company.
- IF 'IBQUIT
- DO SUBTOT^IBOTR4
- +5 QUIT
- +6 ;
- DETAIL ; Write out detail lines.
- +1 NEW IBPEN
- SET IBPEN=$SELECT($PIECE(IBBN,"@@",2)["*":0,1:$PIECE(IBD,"^",6)-$PIECE(IBD,"^",7))
- +2 IF $Y>(IOSL-3)
- SET IBCALC=3
- DO PAUSE
- IF IBQUIT
- QUIT
- DO HDR
- IF IBQUIT
- QUIT
- DO INSADD
- +3 WRITE !,$PIECE(IBBN,"@@",2),?10,$PIECE(IBBN,"@@"),?34,$$DATE($PIECE(IBD,"^",2)),?44,$$DATE($PIECE(IBD,"^",3))
- +4 WRITE ?54,$$DATE($PIECE(IBD,"^",4)),?64,$$DATE($PIECE(IBD,"^",5))
- +5 SET X1=$PIECE(IBD,"^",5)
- SET X2=$PIECE(IBD,"^",4)
- DO ^%DTC
- WRITE ?75,$JUSTIFY(X,4)
- +6 WRITE ?80,$JUSTIFY($PIECE(IBD,"^",6),9,2),?90,$JUSTIFY($PIECE(IBD,"^",7),9,2)
- +7 WRITE ?101,$JUSTIFY($PIECE(IBD,"^",6)-$PIECE(IBD,"^",7),9,2),?111,$JUSTIFY(IBPEN,9,2)
- +8 WRITE ?123,$JUSTIFY($SELECT(+$PIECE(IBD,"^",6)=0:0,1:$PIECE(IBD,"^",7)/$PIECE(IBD,"^",6)*100),6,2)
- +9 SET $PIECE(IBTI,"^")=$PIECE(IBTI,"^")+1
- SET $PIECE(IBTI,"^",2)=$PIECE(IBTI,"^",2)+$PIECE(IBD,"^",6)
- SET $PIECE(IBTI,"^",3)=$PIECE(IBTI,"^",3)+$PIECE(IBD,"^",7)
- SET $PIECE(IBTI,"^",4)=$PIECE(IBTI,"^",4)+IBPEN
- +10 SET $PIECE(IBTT,"^")=$PIECE(IBTT,"^")+1
- SET $PIECE(IBTT,"^",2)=$PIECE(IBTT,"^",2)+$PIECE(IBD,"^",6)
- SET $PIECE(IBTT,"^",3)=$PIECE(IBTT,"^",3)+$PIECE(IBD,"^",7)
- SET $PIECE(IBTT,"^",4)=$PIECE(IBTT,"^",4)+IBPEN
- +11 QUIT
- +12 ;
- HDR ; Print the report header.
- +1 SET IBPAG=IBPAG+1
- IF $EXTRACT(IOST,1,2)["C-"!(IBPAG>1)
- WRITE @IOF
- WRITE IBRTN," PAYMENT TREND REPORT -- "
- +2 WRITE $SELECT(IBX="I":"INPATIENT",IBX="O":"OUTPATIENT",1:"COMBINED INPATIENT AND OUTPATIENT")," BILLING"
- +3 WRITE ?105,IBTDT," PAGE: ",IBPAG
- +4 WRITE !?6,IBDFN,": ",$$DATE(IBBDT)," - ",$$DATE(IBEDT),?57,"Note: '*' after the Bill Number denotes a CLOSED bill"
- +5 IF $DATA(IBAF)
- WRITE !?6,IBAFT
- +6 WRITE !,"BILL",?10,"PATIENT",?55,"DATE",?64,"DATE BILL",?76,"#"
- +7 WRITE ?82,"AMOUNT",?91,"AMOUNT",?103,"AMOUNT",?112,"AMOUNT",?122,"PERCENT"
- +8 WRITE !,"NUMBER",?10,"NAME/ (AGE)",?34,"BILL FROM - TO",?54,"PRINTED"
- +9 WRITE ?65,"CLOSED",?75,"DAYS",?82,"BILLED",?90,"COLLECTED",?103,"UNPAID"
- +10 WRITE ?112,"PENDING",?122,"COLLECTED",!,IBLINE
- +11 SET IBQUIT=$$STOP^IBOUTL("Trend Report")
- +12 QUIT
- +13 ;
- DATE(IBX) IF IBX]""
- SET IBX=$EXTRACT(IBX,4,5)_"/"_$EXTRACT(IBX,6,7)_"/"_$EXTRACT(IBX,2,3)
- QUIT IBX
- +1 ;
- PAUSE IF $EXTRACT(IOST,1,2)'="C-"
- QUIT
- +1 FOR IBI=$Y:1:(IOSL-IBCALC)
- WRITE !
- +2 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)!($DATA(DUOUT))
- SET IBQUIT=1
- KILL DIRUT,DTOUT,DUOUT
- +3 QUIT
- +4 ;
- INSADD ; Display Insurance Company name and address. Input: IBINS
- +1 NEW D,IEN
- +2 WRITE !!?8,"PRIMARY INSURANCE CARRIER: ",$PIECE(IBINS,"@@")
- +3 SET IEN=$PIECE(IBINS,"@@",2)
- IF 'IEN
- GOTO INSADDQ
- +4 SET D=$GET(^DIC(36,IEN,.11))
- IF D=""
- GOTO INSADDQ
- +5 IF $PIECE(D,"^")]""
- WRITE !?36,$PIECE(D,"^")
- +6 IF $PIECE(D,"^",2)]""
- WRITE !?36,$PIECE(D,"^",2)
- +7 IF $PIECE(D,"^",3)]""
- WRITE !?36,$PIECE(D,"^",3)
- +8 IF $PIECE(D,"^")]""!($PIECE(D,"^",2)]"")!($PIECE(D,"^",3)]"")
- WRITE !?36
- +9 WRITE $PIECE(D,"^",4)
- IF $PIECE(D,"^",4)]""&($PIECE(D,"^",5)]"")
- WRITE ", "
- +10 WRITE $PIECE($GET(^DIC(5,+$PIECE(D,"^",5),0)),"^")
- +11 IF $PIECE(D,"^",6)]""&($PIECE(D,"^",4)]""!($PIECE(D,"^",5)]""))
- WRITE " "
- +12 WRITE $PIECE(D,"^",6)
- INSADDQ WRITE !
- QUIT
