Routine: IBORT

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="@"

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)

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"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBORT   3768     printed  Feb 18, 2025@23:52:31                                                                                                                                                                                                       Page 2

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

IBORT.m