IBOSTUS.m

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