IBORAT2C ;ALB/RJS - OUTPUT ROUTINE FOR BILLING RATES REPORT - 1/22/92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
START ;
S IBROUT="IBORAT2B",IBOUTPUT=0
S IBSPEC="",IBOLDSPC=""
F S IBSPEC=$O(^TMP($J,IBROUT,IBSPEC)) Q:IBSPEC=""!(IBDONE) D IBEFFDAT
END ;
K IBCANCEL,IBEFFDAT,IBDATA,IBOLDSPC,IBREVCD,IBREVCDE,IBREVFLG,IBROUT,IBSPEC,X,Y,IBAAA,C
Q
IBEFFDAT ;
S IBEFFDAT=-1
F S IBEFFDAT=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT)) Q:IBEFFDAT=""!(IBDONE) D IBREVCDE
Q
IBREVCDE ;
S IBREVCDE="",IBREVFLG=0
F S IBREVCDE=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT,IBREVCDE)) Q:IBREVCDE=""!(IBDONE) D IBPAYORS
Q
IBPAYORS ;
S IBPAYORS=""
F S IBPAYORS=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT,IBREVCDE,IBPAYORS)) Q:IBPAYORS=""!(IBDONE) D OUTPUT:$$SELECT(IBPAYORS)
Q
OUTPUT ;
I IBREVFLG=0 W ! S IBREVFLG=1
I IBOUTPUT=0 D IBTITLE S (IBOUTPUT,IBZ)=1
I IBOLDSPC'=IBSPEC&($Y+8>IOSL) S IBOLDSPC=IBSPEC D HEADING G LINE
I IBOLDSPC'=IBSPEC S IBOLDSPC=IBSPEC D SUBHEAD
LINE ;
I IBDONE Q
D:$Y+4>IOSL HEADING
I IBDONE Q
S IBDATA=^TMP($J,"IBORAT2B",IBSPEC,IBEFFDAT,IBREVCDE,IBPAYORS)
S Y=IBEFFDAT D DD^%DT
S IBREVCD=$G(^DGCR(399.2,IBREVCDE,0)),IBREVCD=$P(IBREVCD,U,1)
;AMOUNT=PIECE 2, ACTIVE=PIECE 4, PAYORS CODE=PIECE 3,NON STANDARD=$P 5
W !,?2,Y,?19,"$",$P(IBDATA,U,2),?27,IBREVCD
S Y=$P(IBDATA,U,4),C=$P(^DD(399.5,.05,0),U,2) D Y^DIQ W ?37,$S(Y="YES, ACTIVE":"YES",1:"NO")
S Y=IBPAYORS,C=$P(^DD(399.5,.06,0),U,2) D Y^DIQ W ?45,$E(Y,1,20)
S Y=$P(IBDATA,U,5),C=$P(^DD(399.5,.07,0),U,2) D Y^DIQ W ?70,$S(Y="YES":"YES",1:"NO")
Q
SUBHEAD ;
W !!,IBSPEC,!,?2,"Effective Date",?19,"Amount",?27,"Rev Code",?37,"Active",?45,"Payors to use",?66,"Non-Standard"
Q
HEADING ;
F IBAAA=$Y:1:(IOSL-3) W !
I ($E(IOST,1,2)="C-")
I S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="")!($D(DIRUT)) S IBDONE=1 Q
D IBTITLE,SUBHEAD
Q
IBTITLE ;
W @IOF,!,IBTODAY,?25,IBTITLE,?68," PAGE ",IBPAGE
D DATES
S X="",$P(X,"=",IOM)="" W X
S IBPAGE=IBPAGE+1
Q
DATES ;
I IBSDATE=IBEDATE W !,?25," Rates in effect on: ",IBSDATE,! Q
W !,?25," Rates in effect from: ",IBSDATE
W !,?25," to: ",IBEDATE,!
Q
SELECT(IBPAYORS) ;
S IBCANCEL=$P(^TMP($J,IBROUT,IBSPEC,IBEFFDAT,IBREVCDE,IBPAYORS),U,1)
I (IBSTDATE'>IBEFFDAT)&(IBENDATE'<IBEFFDAT) Q 1
I (IBSTDATE'<IBEFFDAT)&(IBSTDATE'>IBCANCEL) Q 1
Q 0
IBORAT2C ;ALB/RJS - OUTPUT ROUTINE FOR BILLING RATES REPORT - 1/22/92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
START ;
+1 SET IBROUT="IBORAT2B"
SET IBOUTPUT=0
+2 SET IBSPEC=""
SET IBOLDSPC=""
+3 FOR
SET IBSPEC=$ORDER(^TMP($JOB,IBROUT,IBSPEC))
IF IBSPEC=""!(IBDONE)
QUIT
DO IBEFFDAT
END ;
+1 KILL IBCANCEL,IBEFFDAT,IBDATA,IBOLDSPC,IBREVCD,IBREVCDE,IBREVFLG,IBROUT,IBSPEC,X,Y,IBAAA,C
+2 QUIT
IBEFFDAT ;
+1 SET IBEFFDAT=-1
+2 FOR
SET IBEFFDAT=$ORDER(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT))
IF IBEFFDAT=""!(IBDONE)
QUIT
DO IBREVCDE
+3 QUIT
IBREVCDE ;
+1 SET IBREVCDE=""
SET IBREVFLG=0
+2 FOR
SET IBREVCDE=$ORDER(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT,IBREVCDE))
IF IBREVCDE=""!(IBDONE)
QUIT
DO IBPAYORS
+3 QUIT
IBPAYORS ;
+1 SET IBPAYORS=""
+2 FOR
SET IBPAYORS=$ORDER(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT,IBREVCDE,IBPAYORS))
IF IBPAYORS=""!(IBDONE)
QUIT
IF $$SELECT(IBPAYORS)
DO OUTPUT
+3 QUIT
OUTPUT ;
+1 IF IBREVFLG=0
WRITE !
SET IBREVFLG=1
+2 IF IBOUTPUT=0
DO IBTITLE
SET (IBOUTPUT,IBZ)=1
+3 IF IBOLDSPC'=IBSPEC&($Y+8>IOSL)
SET IBOLDSPC=IBSPEC
DO HEADING
GOTO LINE
+4 IF IBOLDSPC'=IBSPEC
SET IBOLDSPC=IBSPEC
DO SUBHEAD
LINE ;
+1 IF IBDONE
QUIT
+2 IF $Y+4>IOSL
DO HEADING
+3 IF IBDONE
QUIT
+4 SET IBDATA=^TMP($JOB,"IBORAT2B",IBSPEC,IBEFFDAT,IBREVCDE,IBPAYORS)
+5 SET Y=IBEFFDAT
DO DD^%DT
+6 SET IBREVCD=$GET(^DGCR(399.2,IBREVCDE,0))
SET IBREVCD=$PIECE(IBREVCD,U,1)
+7 ;AMOUNT=PIECE 2, ACTIVE=PIECE 4, PAYORS CODE=PIECE 3,NON STANDARD=$P 5
+8 WRITE !,?2,Y,?19,"$",$PIECE(IBDATA,U,2),?27,IBREVCD
+9 SET Y=$PIECE(IBDATA,U,4)
SET C=$PIECE(^DD(399.5,.05,0),U,2)
DO Y^DIQ
WRITE ?37,$SELECT(Y="YES, ACTIVE":"YES",1:"NO")
+10 SET Y=IBPAYORS
SET C=$PIECE(^DD(399.5,.06,0),U,2)
DO Y^DIQ
WRITE ?45,$EXTRACT(Y,1,20)
+11 SET Y=$PIECE(IBDATA,U,5)
SET C=$PIECE(^DD(399.5,.07,0),U,2)
DO Y^DIQ
WRITE ?70,$SELECT(Y="YES":"YES",1:"NO")
+12 QUIT
SUBHEAD ;
+1 WRITE !!,IBSPEC,!,?2,"Effective Date",?19,"Amount",?27,"Rev Code",?37,"Active",?45,"Payors to use",?66,"Non-Standard"
+2 QUIT
HEADING ;
+1 FOR IBAAA=$Y:1:(IOSL-3)
WRITE !
+2 IF ($EXTRACT(IOST,1,2)="C-")
+3 IF $TEST
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y=0!(Y="")!($DATA(DIRUT))
SET IBDONE=1
QUIT
+4 DO IBTITLE
DO SUBHEAD
+5 QUIT
IBTITLE ;
+1 WRITE @IOF,!,IBTODAY,?25,IBTITLE,?68," PAGE ",IBPAGE
+2 DO DATES
+3 SET X=""
SET $PIECE(X,"=",IOM)=""
WRITE X
+4 SET IBPAGE=IBPAGE+1
+5 QUIT
DATES ;
+1 IF IBSDATE=IBEDATE
WRITE !,?25," Rates in effect on: ",IBSDATE,!
QUIT
+2 WRITE !,?25," Rates in effect from: ",IBSDATE
+3 WRITE !,?25," to: ",IBEDATE,!
+4 QUIT
SELECT(IBPAYORS) ;
+1 SET IBCANCEL=$PIECE(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT,IBREVCDE,IBPAYORS),U,1)
+2 IF (IBSTDATE'>IBEFFDAT)&(IBENDATE'<IBEFFDAT)
QUIT 1
+3 IF (IBSTDATE'<IBEFFDAT)&(IBSTDATE'>IBCANCEL)
QUIT 1
+4 QUIT 0
