IBOSTUS ;ALB/SGD - MCCR BILL STATUS REPORT ;25 MAY 88 14:19
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;MAP TO DGCROST
;
;***
;S XRTL=$ZU(0),XRTN="IBOSTUS-1" D T0^%ZOSV ;start rt clock
N IBDTP ; date type chosen for sorting
I '$D(DT) D DT^DICRW
YN W !!,"DO YOU WANT TO PRINT THE STATUS OF ALL BILLS" S %=1 D YN^DICN G Q:%=-1 S:%=1 IBBST="ALL" G SORT:%=1 I %=0 W !,"CHOOSE Y (YES) OR N (NO)" G YN
CHOOSE S Z="^ENTERED/NOT REVIEWED^REVIEWED^AUTHORIZED^PRINTED^CANCELLED" R !!,"CHOOSE A BILL STATUS: ",X:DTIME G HELP:X["?" G Q:(X["^")!(X="") D IN^DGHELP S IBBST=$E(X,1) I %=-1 W *7," ??" G HELP
S IBHD2=$S(IBBST="A":"AUTHORIZED",IBBST="E":"ENTERED/NOT REVIEWED",IBBST="R":"REVIEWED",IBBST="P":"PRINTED",IBBST="C":"CANCELLED",1:"")
SORT ; chose the date type to sort on
S DIR(0)="S^1:EVENT DATE;2:BILL DATE;3:ENTERED DATE"
S DIR("A")="SORT BY",DIR("B")=1,DIR("?")="^D HELP2^IBOSTUS"
D ^DIR K DIR Q:$D(DIRUT)
S IBDTP=$S(Y=1:"Event",Y=2:"Bill",Y=3:"Entered",1:"") Q:IBDTP=""
DATE W ! S %DT="AEPX",%DT("A")="Start with "_IBDTP_" DATE: ",%DT(0)=-DT D ^%DT G Q:Y<0 S IBBEG=Y
DATE1 S %DT="EPX" W !,"Go to "_IBDTP_" DATE: TODAY// " R X:DTIME S:X=" " X=IBBEG G Q:(X["^") S:X="" X="TODAY" 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," ??" G DATE1
;
W !!,*7,"*** Margin width of this output is 132 ***"
;S DGPGM="QUEUED^IBOSTUS",DGVAR="IBDTP^IBBST^IBHD2^IBBEG^IBEND^DUZ" D ZIS^DGUTQ G Q:POP
;
S %ZIS="QM" D ^%ZIS G:POP Q
I $D(IO("Q")) K IO("Q") D G Q
.S ZTRTN="QUEUED^IBOSTUS",ZTDESC="IB - Bill Status Report",ZTSAVE("IB*")=""
.D ^%ZTLOAD K ZTSK D HOME^%ZIS
;
U IO
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOSTUS" D T1^%ZOSV ;stop rt clock
QUEUED ; entry point if queued
;***
;S XRTL=$ZU(0),XRTN="IBOSTUS-2" D T0^%ZOSV ;start rt clock
;
; K ^TMP($J)
; D:IBDTP="Entered" INDX ; DATE ENTERED is not cross-referenced
G BEGIN^IBOSTUS1
;
Q K %,I,J,X,X1,X2,Y,Z,IBIFN,%DT,IBAPP,POP,IBPAGE,DGPGM,DGVAR,IBNEX,IBF,IBBEG,IBEND,IBHD,IBHD2,IBL,IBL1,IBBST,IBBS,IBBSBY,IBBSDT,IB0,IBS
I '$D(ZTQUEUED) D ^%ZISC
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOSTUS" D T1^%ZOSV ;stop rt clock
Q
;
HELP W !!,"CHOOSE FROM: ","ENTERED/NOT REVIEWED",!?13,"REVIEWED",!?13,"AUTHORIZED",!?13,"PRINTED",!?13,"CANCELLED" G CHOOSE
Q
HELP2 ; help for SORT BY:
W !!," EVENT DATE is the date beginning the bill's episode of care"
W !!," BILL DATE is the date the bill was initially printed"
W !!," ENTERED DATE is the date the bill was first entered"
Q
INDX ; creates a temporary index of bills sorted by bill date=initial printed
N D S IBNEX=0 F S IBNEX=$O(^DGCR(399,IBNEX)) Q:'IBNEX S D=$P($G(^DGCR(399,IBNEX,"S")),"^",1) D:D&(D'<(IBBEG\1))&(D'>(IBEND\1_.2359))
.S ^TMP($J,"ENTERED",D,IBNEX)=""
Q
STATS ; prints statistics
S IBHDR3="REPORT STATISTICS" D HEAD^IBOSTUS1
S IBST1="RATE TYPE : "
S IBST2="BILL STATUS: "
F I="IBST1","IBST2" N IBTOT D W:'IBCRT !!!!
.S IBCAT="" F W ! S IBCAT=$O(@I@(IBCAT)) Q:IBCAT="" D
..I IBCRT,($Y>(IOSL-2)) D HEAD^IBOSTUS1
.. S X=@I@(IBCAT,"$"),X2="2$" D COMMA^%DTC
..W !,IBCAT,?18,".................... ",?42,$J(X,15),?60,$J(@I@(IBCAT,"C"),6),?67," BILLS"
..S IBTOT("C")=$G(IBTOT("C"))+@I@(IBCAT,"C")
..S IBTOT("$")=$G(IBTOT("$"))+@I@(IBCAT,"$")
.W !,?40,"-----------------",?60,"-------------"
.S X=$G(IBTOT("$")),X2="2$" D COMMA^%DTC
.W !?42,$J(X,15),?60,$J($G(IBTOT("C")),6),?67," BILLS"
Q
IBOSTUS ;ALB/SGD - MCCR BILL STATUS REPORT ;25 MAY 88 14:19
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;MAP TO DGCROST
+4 ;
+5 ;***
+6 ;S XRTL=$ZU(0),XRTN="IBOSTUS-1" D T0^%ZOSV ;start rt clock
+7 ; date type chosen for sorting
NEW IBDTP
+8 IF '$DATA(DT)
DO DT^DICRW
YN WRITE !!,"DO YOU WANT TO PRINT THE STATUS OF ALL BILLS"
SET %=1
DO YN^DICN
IF %=-1
GOTO Q
IF %=1
SET IBBST="ALL"
IF %=1
GOTO SORT
IF %=0
WRITE !,"CHOOSE Y (YES) OR N (NO)"
GOTO YN
CHOOSE SET Z="^ENTERED/NOT REVIEWED^REVIEWED^AUTHORIZED^PRINTED^CANCELLED"
READ !!,"CHOOSE A BILL STATUS: ",X:DTIME
IF X["?"
GOTO HELP
IF (X["^")!(X="")
GOTO Q
DO IN^DGHELP
SET IBBST=$EXTRACT(X,1)
IF %=-1
WRITE *7," ??"
GOTO HELP
+1 SET IBHD2=$SELECT(IBBST="A":"AUTHORIZED",IBBST="E":"ENTERED/NOT REVIEWED",IBBST="R":"REVIEWED",IBBST="P":"PRINTED",IBBST="C":"CANCELLED",1:"")
SORT ; chose the date type to sort on
+1 SET DIR(0)="S^1:EVENT DATE;2:BILL DATE;3:ENTERED DATE"
+2 SET DIR("A")="SORT BY"
SET DIR("B")=1
SET DIR("?")="^D HELP2^IBOSTUS"
+3 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+4 SET IBDTP=$SELECT(Y=1:"Event",Y=2:"Bill",Y=3:"Entered",1:"")
IF IBDTP=""
QUIT
DATE WRITE !
SET %DT="AEPX"
SET %DT("A")="Start with "_IBDTP_" DATE: "
SET %DT(0)=-DT
DO ^%DT
IF Y<0
GOTO Q
SET IBBEG=Y
DATE1 SET %DT="EPX"
WRITE !,"Go to "_IBDTP_" DATE: TODAY// "
READ X:DTIME
IF X=" "
SET X=IBBEG
IF (X["^")
GOTO Q
IF X=""
SET X="TODAY"
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," ??"
GOTO DATE1
+2 ;
+3 WRITE !!,*7,"*** Margin width of this output is 132 ***"
+4 ;S DGPGM="QUEUED^IBOSTUS",DGVAR="IBDTP^IBBST^IBHD2^IBBEG^IBEND^DUZ" D ZIS^DGUTQ G Q:POP
+5 ;
+6 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO Q
+7 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+8 SET ZTRTN="QUEUED^IBOSTUS"
SET ZTDESC="IB - Bill Status Report"
SET ZTSAVE("IB*")=""
+9 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO Q
+10 ;
+11 USE IO
+12 ;***
+13 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOSTUS" D T1^%ZOSV ;stop rt clock
QUEUED ; entry point if queued
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBOSTUS-2" D T0^%ZOSV ;start rt clock
+3 ;
+4 ; K ^TMP($J)
+5 ; D:IBDTP="Entered" INDX ; DATE ENTERED is not cross-referenced
+6 GOTO BEGIN^IBOSTUS1
+7 ;
Q KILL %,I,J,X,X1,X2,Y,Z,IBIFN,%DT,IBAPP,POP,IBPAGE,DGPGM,DGVAR,IBNEX,IBF,IBBEG,IBEND,IBHD,IBHD2,IBL,IBL1,IBBST,IBBS,IBBSBY,IBBSDT,IB0,IBS
+1 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+2 ;***
+3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOSTUS" D T1^%ZOSV ;stop rt clock
+4 QUIT
+5 ;
HELP WRITE !!,"CHOOSE FROM: ","ENTERED/NOT REVIEWED",!?13,"REVIEWED",!?13,"AUTHORIZED",!?13,"PRINTED",!?13,"CANCELLED"
GOTO CHOOSE
+1 QUIT
HELP2 ; help for SORT BY:
+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 WRITE !!," ENTERED DATE is the date the bill was first entered"
+4 QUIT
INDX ; creates a temporary index of bills sorted by bill date=initial printed
+1 NEW D
SET IBNEX=0
FOR
SET IBNEX=$ORDER(^DGCR(399,IBNEX))
IF 'IBNEX
QUIT
SET D=$PIECE($GET(^DGCR(399,IBNEX,"S")),"^",1)
IF D&(D'<(IBBEG\1))&(D'>(IBEND\1_.2359))
Begin DoDot:1
+2 SET ^TMP($JOB,"ENTERED",D,IBNEX)=""
End DoDot:1
+3 QUIT
STATS ; prints statistics
+1 SET IBHDR3="REPORT STATISTICS"
DO HEAD^IBOSTUS1
+2 SET IBST1="RATE TYPE : "
+3 SET IBST2="BILL STATUS: "
+4 FOR I="IBST1","IBST2"
NEW IBTOT
Begin DoDot:1
+5 SET IBCAT=""
FOR
WRITE !
SET IBCAT=$ORDER(@I@(IBCAT))
IF IBCAT=""
QUIT
Begin DoDot:2
+6 IF IBCRT
IF ($Y>(IOSL-2))
DO HEAD^IBOSTUS1
+7 SET X=@I@(IBCAT,"$")
SET X2="2$"
DO COMMA^%DTC
+8 WRITE !,IBCAT,?18,".................... ",?42,$JUSTIFY(X,15),?60,$JUSTIFY(@I@(IBCAT,"C"),6),?67," BILLS"
+9 SET IBTOT("C")=$GET(IBTOT("C"))+@I@(IBCAT,"C")
+10 SET IBTOT("$")=$GET(IBTOT("$"))+@I@(IBCAT,"$")
End DoDot:2
+11 WRITE !,?40,"-----------------",?60,"-------------"
+12 SET X=$GET(IBTOT("$"))
SET X2="2$"
DO COMMA^%DTC
+13 WRITE !?42,$JUSTIFY(X,15),?60,$JUSTIFY($GET(IBTOT("C")),6),?67," BILLS"
End DoDot:1
IF 'IBCRT
WRITE !!!!
+14 QUIT
