IBORT ;ALB/MRL,SGD - MAS BILLING TOTALS REPORT ;25 MAY 88 09:10
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;MAP TO DGCRORT
;
;***
;S XRTL=$ZU(0),XRTN="IBORT-1" D T0^%ZOSV ;start rt clock
N IBDTP,IBIDX
S:'$D(U) U="^" S:'$D(DTIME) DTIME=600 I '$D(DT) S X="T",DT="" D ^%DT S DT=Y K X,Y,^UTILITY($J)
SELECT ; chose the date type to select by
S DIR(0)="S^1:EVENT DATE;2:BILL DATE"
S DIR("A")="SELECT BILLS BY",DIR("B")=1,DIR("?")="^D HELP^IBORT"
D ^DIR K DIR Q:$D(DIRUT)
S IBDTP=$S(Y=1:"EVENT",Y=2:"BILL",1:"") Q:IBDTP=""
DATE S %DT="AEPX",%DT("A")="Start with "_IBDTP_" DATE: " D ^%DT G Q:Y<0 S IBBEG=Y I IBBEG>DT W *7," ??",!,"Date must be in the past." G DATE
DATE1 S %DT="EPX" R !,"Go to DATE: ",X:DTIME S:X=" " X=IBBEG G Q:(X="")!(X["^") D ^%DT G DATE1:Y<0 S IBEND=Y I IBEND<IBBEG W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G DATE1
I IBEND>DT W *7," ??",!,"Date must be in the past." G DATE1
;
W !!,*7,"*** Margin width of this output is 132 ***"
;S DGPGM="BEGIN^IBORT",DGVAR="IBBEG^IBEND^DUZ^IBDTP" D ZIS^DGUTQ G Q:POP U IO
S %ZIS="QM" D ^%ZIS G:POP Q
;
I $D(IO("Q")) K IO("Q") D G Q
.S ZTRTN="BEGIN^IBORT",ZTSAVE("IB*")="",ZTDESC="IB - BILLING TOTALS REPORT"
.D ^%ZTLOAD K ZTSK D HOME^%ZIS
;
U IO
;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBORT" D T1^%ZOSV ;stop rt clock
BEGIN ;
;***
;S XRTL=$ZU(0),XRTN="IBORT-2" D T0^%ZOSV ;start rt clock
S (IBL,IBL1)="",$P(IBL,"_",131)="",$P(IBL1,"=",131)="",Y=IBBEG X ^DD("DD") S IBHD="for "_$S(IBBEG'=IBEND:"period covering ",1:"")_Y I IBBEG<IBEND S Y=IBEND X ^DD("DD") S IBHD=IBHD_" through "_Y
S X1=IBBEG,X2=-1 D C^%DTC S IBD=X_.9999,IBD1=IBEND_.2359,IBNEX=0
F I=0:0 S IBNEX=$O(^DGCR(399.3,IBNEX)) Q:'IBNEX S IBX=$P(^(IBNEX,0),"^",1),^UTILITY($J,"IB","T",IBX)="",^UTILITY($J,"IB","T1",IBX)=""
S ^UTILITY($J,"IB","TT")="",^("TS")="",^UTILITY($J,"IB","T","UNKNOWN")="",^UTILITY($J,"IB","T1","UNKNOWN")=""
S IBIDX=$S(IBDTP="BILL":"AP",1:"D")
F I=0:0 S IBD=$O(^DGCR(399,IBIDX,IBD)) Q:'IBD!(IBD>IBD1) S DFN="" F J=0:0 S DFN=$O(^DGCR(399,IBIDX,IBD,DFN)) Q:'DFN I $D(^DGCR(399,+DFN,0)) S IB=^(0) I $P(IB,"^",1)'="",$P(IB,"^",3) D SET^IBORT1
S IBB=1,X=132 X ^%ZOSF("RM") D HEAD S IBNEX=0 F I=0:0 S IBNEX=$O(^UTILITY($J,"IB","T",IBNEX)) Q:IBNEX="" S IBP=^(IBNEX) W !,IBNEX F I1=1:2:7 D WRITE
W !,IBL,!,"TOTALS" S IBP=^UTILITY($J,"IB","TT") F I1=1:2:7 D WRITE
S IBB=0 D HEAD S IBNEX=0 F I=0:0 S IBNEX=$O(^UTILITY($J,"IB","T1",IBNEX)) Q:IBNEX="" S IBP=^(IBNEX) W !,IBNEX F I1=1:2:7 D WRITE
W !,IBL,!,"PENDING TOTALS" S IBP=^UTILITY($J,"IB","TS") F I1=1:2:7 D WRITE
Q K X,X1,X2,Y,I,I1,J,DFN,IB,IBTOT,IBN1,IBN2,%DT,%,IBD,IBD1,IBHD,IBNEX,IBP,IBTAB,IBX,POP,IBBEG,IBEND,IBL,IBL1,IBB,IBS,^UTILITY($J),IBDTP,IBIDX
I '$D(ZTQUEUED) D ^%ZISC
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBORT" D T1^%ZOSV ;stop rt clock
I $D(ZTQUEUED) S ZTREQ="@"
Q
WRITE S IBTAB=$S(I1=1:34,I1=3:59,I1=5:84,1:109),IBN1=+$P(IBP,"^",I1),IBN2=+$P(IBP,"^",I1+1) W ?IBTAB,$J(IBN1,5) S X=IBN2,X2="2$" D COMMA^%DTC S X=X_"|" W ?(IBTAB+7),$J(X,15)
Q
HEAD W !,@IOF,! D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W ?94,"Date/Time Printed: ",Y,!!,$S(IBB:"Billing Summary Report ",1:"Summary of Pending Bill Authorizations "),IBHD," (by "_$S(IBDTP="EVENT":"Event Date)",1:"Date Billed)")
W !,IBL,!
I IBB W ?39,"INITIATED",?55,"|",?65,"PENDING",?80,"|",?89,"PRINTED",?105,"|",?114,"CANCELLED",?130,"|"
E W ?38,"TOTAL PENDING",?55,"|",?64,"NO ACTION",?80,"|",?89,"REVIEWED",?105,"|",?114,"AUTHORIZED",?130,"|"
W !,"BILL TYPE" F IBTAB=33,58,83,108 W ?IBTAB,"Number Dollars|"
W !,IBL1 Q
HELP ; help for date type selection
W !!,"EVENT DATE is the date beginning the bill's episode of care"
W !!,"BILL DATE is the date the bill was initially printed"
Q
IBORT ;ALB/MRL,SGD - MAS BILLING TOTALS REPORT ;25 MAY 88 09:10
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;MAP TO DGCRORT
+4 ;
+5 ;***
+6 ;S XRTL=$ZU(0),XRTN="IBORT-1" D T0^%ZOSV ;start rt clock
+7 NEW IBDTP,IBIDX
+8 IF '$DATA(U)
SET U="^"
IF '$DATA(DTIME)
SET DTIME=600
IF '$DATA(DT)
SET X="T"
SET DT=""
DO ^%DT
SET DT=Y
KILL X,Y,^UTILITY($JOB)
SELECT ; chose the date type to select by
+1 SET DIR(0)="S^1:EVENT DATE;2:BILL DATE"
+2 SET DIR("A")="SELECT BILLS BY"
SET DIR("B")=1
SET DIR("?")="^D HELP^IBORT"
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+4 SET IBDTP=$SELECT(Y=1:"EVENT",Y=2:"BILL",1:"")
IF IBDTP=""
QUIT
DATE SET %DT="AEPX"
SET %DT("A")="Start with "_IBDTP_" DATE: "
DO ^%DT
IF Y<0
GOTO Q
SET IBBEG=Y
IF IBBEG>DT
WRITE *7," ??",!,"Date must be in the past."
GOTO DATE
DATE1 SET %DT="EPX"
READ !,"Go to DATE: ",X:DTIME
IF X=" "
SET X=IBBEG
IF (X="")!(X["^")
GOTO Q
DO ^%DT
IF Y<0
GOTO DATE1
SET IBEND=Y
IF IBEND<IBBEG
WRITE *7," ??",!,"ENDING DATE must follow BEGINNING DATE."
GOTO DATE1
+1 IF IBEND>DT
WRITE *7," ??",!,"Date must be in the past."
GOTO DATE1
+2 ;
+3 WRITE !!,*7,"*** Margin width of this output is 132 ***"
+4 ;S DGPGM="BEGIN^IBORT",DGVAR="IBBEG^IBEND^DUZ^IBDTP" D ZIS^DGUTQ G Q:POP U IO
+5 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO Q
+6 ;
+7 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+8 SET ZTRTN="BEGIN^IBORT"
SET ZTSAVE("IB*")=""
SET ZTDESC="IB - BILLING TOTALS REPORT"
+9 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO Q
+10 ;
+11 USE IO
+12 ;
+13 ;***
+14 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBORT" D T1^%ZOSV ;stop rt clock
BEGIN ;
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBORT-2" D T0^%ZOSV ;start rt clock
+3 SET (IBL,IBL1)=""
SET $PIECE(IBL,"_",131)=""
SET $PIECE(IBL1,"=",131)=""
SET Y=IBBEG
XECUTE ^DD("DD")
SET IBHD="for "_$SELECT(IBBEG'=IBEND:"period covering ",1:"")_Y
IF IBBEG<IBEND
SET Y=IBEND
XECUTE ^DD("DD")
SET IBHD=IBHD_" through "_Y
+4 SET X1=IBBEG
SET X2=-1
DO C^%DTC
SET IBD=X_.9999
SET IBD1=IBEND_.2359
SET IBNEX=0
+5 FOR I=0:0
SET IBNEX=$ORDER(^DGCR(399.3,IBNEX))
IF 'IBNEX
QUIT
SET IBX=$PIECE(^(IBNEX,0),"^",1)
SET ^UTILITY($JOB,"IB","T",IBX)=""
SET ^UTILITY($JOB,"IB","T1",IBX)=""
+6 SET ^UTILITY($JOB,"IB","TT")=""
SET ^("TS")=""
SET ^UTILITY($JOB,"IB","T","UNKNOWN")=""
SET ^UTILITY($JOB,"IB","T1","UNKNOWN")=""
+7 SET IBIDX=$SELECT(IBDTP="BILL":"AP",1:"D")
+8 FOR I=0:0
SET IBD=$ORDER(^DGCR(399,IBIDX,IBD))
IF 'IBD!(IBD>IBD1)
QUIT
SET DFN=""
FOR J=0:0
SET DFN=$ORDER(^DGCR(399,IBIDX,IBD,DFN))
IF 'DFN
QUIT
IF $DATA(^DGCR(399,+DFN,0))
SET IB=^(0)
IF $PIECE(IB,"^",1)'=""
IF $PIECE(IB,"^",3)
DO SET^IBORT1
+9 SET IBB=1
SET X=132
XECUTE ^%ZOSF("RM")
DO HEAD
SET IBNEX=0
FOR I=0:0
SET IBNEX=$ORDER(^UTILITY($JOB,"IB","T",IBNEX))
IF IBNEX=""
QUIT
SET IBP=^(IBNEX)
WRITE !,IBNEX
FOR I1=1:2:7
DO WRITE
+10 WRITE !,IBL,!,"TOTALS"
SET IBP=^UTILITY($JOB,"IB","TT")
FOR I1=1:2:7
DO WRITE
+11 SET IBB=0
DO HEAD
SET IBNEX=0
FOR I=0:0
SET IBNEX=$ORDER(^UTILITY($JOB,"IB","T1",IBNEX))
IF IBNEX=""
QUIT
SET IBP=^(IBNEX)
WRITE !,IBNEX
FOR I1=1:2:7
DO WRITE
+12 WRITE !,IBL,!,"PENDING TOTALS"
SET IBP=^UTILITY($JOB,"IB","TS")
FOR I1=1:2:7
DO WRITE
Q KILL X,X1,X2,Y,I,I1,J,DFN,IB,IBTOT,IBN1,IBN2,%DT,%,IBD,IBD1,IBHD,IBNEX,IBP,IBTAB,IBX,POP,IBBEG,IBEND,IBL,IBL1,IBB,IBS,^UTILITY($JOB),IBDTP,IBIDX
+1 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+2 ;***
+3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBORT" D T1^%ZOSV ;stop rt clock
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
WRITE SET IBTAB=$SELECT(I1=1:34,I1=3:59,I1=5:84,1:109)
SET IBN1=+$PIECE(IBP,"^",I1)
SET IBN2=+$PIECE(IBP,"^",I1+1)
WRITE ?IBTAB,$JUSTIFY(IBN1,5)
SET X=IBN2
SET X2="2$"
DO COMMA^%DTC
SET X=X_"|"
WRITE ?(IBTAB+7),$JUSTIFY(X,15)
+1 QUIT
HEAD WRITE !,@IOF,!
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
WRITE ?94,"Date/Time Printed: ",Y,!!,$SELECT(IBB:"Billing Summary Report ",1:"Summary of Pending Bill Authorizations "),IBHD," (by "_$SELECT(IBDTP="EVENT":"Event Date)",1:"Date Billed)")
+1 WRITE !,IBL,!
+2 IF IBB
WRITE ?39,"INITIATED",?55,"|",?65,"PENDING",?80,"|",?89,"PRINTED",?105,"|",?114,"CANCELLED",?130,"|"
+3 IF '$TEST
WRITE ?38,"TOTAL PENDING",?55,"|",?64,"NO ACTION",?80,"|",?89,"REVIEWED",?105,"|",?114,"AUTHORIZED",?130,"|"
+4 WRITE !,"BILL TYPE"
FOR IBTAB=33,58,83,108
WRITE ?IBTAB,"Number Dollars|"
+5 WRITE !,IBL1
QUIT
HELP ; help for date type selection
+1 WRITE !!,"EVENT DATE is the date beginning the bill's episode of care"
+2 WRITE !!,"BILL DATE is the date the bill was initially printed"
+3 QUIT
