IBAGMM1 ;WOIFO/AAT-GMT MONTHLY TOTALS REPORT;30-JUL-02
;;2.0;INTEGRATED BILLING;**183**;21-MAR-94
;; Per VHA Directive 10-93-142, this routine should not be modified
Q
;
; Prints report to the current device
;
; Input:
; IBBDT - Beginning date
; IBEDT - Ending date
; Output:
; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
REPORT ;
N IBDT,IBDTE,IBDTH,IBCR,IBDA,IBAT,IBBG,IBTMP,IBZ,IBCL
S IBQUIT=0
S IBTMP=$NA(^TMP($J,"IBAGMM")) ; The node of TMP array
K @IBTMP
;
; Scan charges, created in the date range IBBDT-31 .. IBEDT
; a charge cannot be for period longer than 30 days.
; Index -
;
; Get the charges from file #350 to the temporary global
; IBDT here - Parent Event Date
S IBDT=$$PLUS(IBBDT,-31) F S IBDT=$O(^IB("D",IBDT)) Q:'IBDT Q:$P(IBDT,".")>IBEDT D
. S IBCR=0 F S IBCR=$O(^IB("D",IBDT,IBCR)) Q:'IBCR D PROC(IBCR)
;
D PRINT
K @IBTMP ; Kill the temporary global node
S:$D(ZTQUEUED) ZTREQ="@" ; for Taskman
Q
;
PRINT ; Print report from the temp. global
N IBLINE,IBPAG,IBTOT,IBTOTS,IBTOTI,IBD,IBTY,IBDA,IBY,IBCHG,IBSAV,IBSEQ,IBMON,X,X2,X3,Y,%
D NOW^%DTC S IBDTH=$$FMTE^XLFDT($E(%,1,12))
S IBLINE="",$P(IBLINE,"=",IOM+1)="",(IBPAG,IBTOT,IBTOTS,IBTOTI,IBQUIT,IBCHG)=0
D HDR
I '$D(@IBTMP@("M")) W !!,"No GMT charges found within the specified period" D PAUSE(1) Q
; - first, print detail lines
F IBMON=$E(IBBDT,1,5):1:$E(IBEDT,1,5) D Q:IBQUIT
. D CHKSTOP Q:IBQUIT
. S IBY=$G(@IBTMP@("M",IBMON))
. W !,$$MON($E(IBMON,4,5)),?10,1700+$E(IBMON,1,3)
. ;W ?16,$J($P(IBY,U,1),4) ;Number of charges not required
. W ?22,$J($P(IBY,U,2),3)
. W ?31,$$FORMAT($P(IBY,U,3),12,2),?46,$$FORMAT($P(IBY,U,4),12,2)
. I $P(IBY,U,5) W ?61,$$FORMAT($P(IBY,U,5),12,2)
. S IBTOT=IBTOT+$P(IBY,U,3),IBTOTS=IBTOTS+$P(IBY,U,4),IBTOTI=IBTOTI+$P(IBY,U,5)
Q:IBQUIT
I (IBTOT!IBTOTI) D TOTALS
D PAUSE(1)
Q
;Number format
FORMAT(IBNUM,IBDIG,IBFRM) N X,X1,X2,X3
S X=IBNUM,X2=$G(IBFRM,"2$"),X3=IBDIG
D COMMA^%DTC
Q X
;
CHKSTOP I $Y>(IOSL-5) D PAUSE(0) Q:IBQUIT D HDR
Q
;
;
HDR ; Print header.
N IBI
I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
S IBH="GMT MONTHLY TOTALS REPORT"
S IBPAG=IBPAG+1 W ?(70-$L(IBH)\2),IBH
W !,"From ",$$DAT(IBBDT)," through ",$$DAT(IBEDT)
W ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
W !!," MONTH",?10,"YEAR",?16,"# GMT PATIENTS ",?32,"GMT BILLED",?48,"GMT DIFF",?65,"PENDING"
W ! F IBI=1:1:80 W "-"
Q
;
TOTALS N IBI,X
W !,?30 F IBI=1:1:45 W "-"
W !,?29,$$FORMAT(IBTOT,14),?44,$$FORMAT(IBTOTS,14),?59,$$FORMAT(IBTOTI,14)
Q
;
STAT() ; Display bill number or status
N IBSTAT S IBSTAT=$G(^IBE(350.21,+$P(IBZ,U,5),0))
Q $S($P(IBSTAT,U,6):$$HLD(+$P(IBZ,U,5)),$P(IBZ,U,5)=99:"Converted",$P(IBZ,U,11)]"":$P($P(IBZ,U,11),"-",2),$P(IBSTAT,U,5):"Cancelled",1:"Pending")
;
HLD(STAT) ; Return an 'on hold' status string
Q "Hold "_$S(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
;
PAUSE(IBEND) ;
Q:$E(IOST,1,2)'["C-"
N IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
W !! ;F IBJ=$Y:1:(IOSL-4) W !
S DIR(0)="E"
I $G(IBEND) S DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
I $G(IBEND) W @IOF
Q
;
DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
Q $$FMTE^XLFDT(IBDT,"2MZ")
;
PLUS(IBDT,IBDAYS) N X,X1,X2
S X1=IBDT,X2=IBDAYS
D C^%DTC
Q X
;
;Add the data to tmp global, if needed.
PROC(IBDA) N IBDTBT,IBMON,IBZ,IBY,IBDFN,IBSTA,IBCRG,IBSEQ,IBGMT
S IBZ=$G(^IB(IBDA,0)) I 'IBZ Q
S IBSTA=$P(IBZ,U,5) I IBSTA=9 Q ; ERROR charges will not be considered
S IBCRG=$P(IBZ,U,7) I 'IBCRG Q ;Zero amount
Q:$P(IBZ,U,8)["ADMISSION"
S IBDTBT=$P(IBZ,U,15) S:IBDTBT="" IBDTBT=$P(IBZ,U,14)
S IBDTBT=$P(IBDTBT,".")
Q:IBDTBT<IBBDT Q:IBDTBT>IBEDT ;"BILLED TO" date must be within the date range
; Do not include cancelled charges with no bill No.
I $P(IBZ,U,11)="",$P($G(^IBE(350.21,+$P(IBZ,U,5),0)),U,5) Q
S IBGMT=$P(IBZ,U,21)
S IBSEQ=$P($G(^IBE(350.1,+$P(IBZ,U,3),0)),U,5)
I IBSEQ=2,'IBGMT,$P(IBZ,U,9) S IBGMT=$P($G(^IB(+$P(IBZ,U,9),0)),U,21) ; Maybe the parent charge is GMT RELATED?
Q:'IBGMT ; The charge is not GMT RELATED.
I IBSEQ=2 S IBCRG=-IBCRG
S IBMON=$E(IBDTBT,1,5) ;Month
S IBDFN=$P(IBZ,U,2)
S IBY=$G(@IBTMP@("M",IBMON)) ;Monthly statistics node
S $P(IBY,U,1)=$P(IBY,U,1)+1 ; Charge Counter
I '$D(@IBTMP@("P",IBDFN,IBMON)) S $P(IBY,U,2)=$P(IBY,U,2)+1,@IBTMP@("P",IBDFN,IBMON)="" ; Patient Counter
I IBSTA'=1 S $P(IBY,U,3)=$P(IBY,U,3)+IBCRG ; GMT Charges Monthly Total
I IBSTA'=1 S $P(IBY,U,4)=$P(IBY,U,4)+(IBCRG*4) ; GMT Charges Monthly Difference
I IBSTA=1 S $P(IBY,U,5)=$P(IBY,U,5)+IBCRG ; GMT Incompleted Charges Monthly Total
S @IBTMP@("M",IBMON)=IBY
Q
MON(IBMON) I (IBMON<1)!(IBMON>12) Q ""
Q $P("JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"," ",IBMON)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAGMM1 4896 printed Oct 16, 2024@18:06:59 Page 2
IBAGMM1 ;WOIFO/AAT-GMT MONTHLY TOTALS REPORT;30-JUL-02
+1 ;;2.0;INTEGRATED BILLING;**183**;21-MAR-94
+2 ;; Per VHA Directive 10-93-142, this routine should not be modified
+3 QUIT
+4 ;
+5 ; Prints report to the current device
+6 ;
+7 ; Input:
+8 ; IBBDT - Beginning date
+9 ; IBEDT - Ending date
+10 ; Output:
+11 ; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
REPORT ;
+1 NEW IBDT,IBDTE,IBDTH,IBCR,IBDA,IBAT,IBBG,IBTMP,IBZ,IBCL
+2 SET IBQUIT=0
+3 ; The node of TMP array
SET IBTMP=$NAME(^TMP($JOB,"IBAGMM"))
+4 KILL @IBTMP
+5 ;
+6 ; Scan charges, created in the date range IBBDT-31 .. IBEDT
+7 ; a charge cannot be for period longer than 30 days.
+8 ; Index -
+9 ;
+10 ; Get the charges from file #350 to the temporary global
+11 ; IBDT here - Parent Event Date
+12 SET IBDT=$$PLUS(IBBDT,-31)
FOR
SET IBDT=$ORDER(^IB("D",IBDT))
if 'IBDT
QUIT
if $PIECE(IBDT,".")>IBEDT
QUIT
Begin DoDot:1
+13 SET IBCR=0
FOR
SET IBCR=$ORDER(^IB("D",IBDT,IBCR))
if 'IBCR
QUIT
DO PROC(IBCR)
End DoDot:1
+14 ;
+15 DO PRINT
+16 ; Kill the temporary global node
KILL @IBTMP
+17 ; for Taskman
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+18 QUIT
+19 ;
PRINT ; Print report from the temp. global
+1 NEW IBLINE,IBPAG,IBTOT,IBTOTS,IBTOTI,IBD,IBTY,IBDA,IBY,IBCHG,IBSAV,IBSEQ,IBMON,X,X2,X3,Y,%
+2 DO NOW^%DTC
SET IBDTH=$$FMTE^XLFDT($EXTRACT(%,1,12))
+3 SET IBLINE=""
SET $PIECE(IBLINE,"=",IOM+1)=""
SET (IBPAG,IBTOT,IBTOTS,IBTOTI,IBQUIT,IBCHG)=0
+4 DO HDR
+5 IF '$DATA(@IBTMP@("M"))
WRITE !!,"No GMT charges found within the specified period"
DO PAUSE(1)
QUIT
+6 ; - first, print detail lines
+7 FOR IBMON=$EXTRACT(IBBDT,1,5):1:$EXTRACT(IBEDT,1,5)
Begin DoDot:1
+8 DO CHKSTOP
if IBQUIT
QUIT
+9 SET IBY=$GET(@IBTMP@("M",IBMON))
+10 WRITE !,$$MON($EXTRACT(IBMON,4,5)),?10,1700+$EXTRACT(IBMON,1,3)
+11 ;W ?16,$J($P(IBY,U,1),4) ;Number of charges not required
+12 WRITE ?22,$JUSTIFY($PIECE(IBY,U,2),3)
+13 WRITE ?31,$$FORMAT($PIECE(IBY,U,3),12,2),?46,$$FORMAT($PIECE(IBY,U,4),12,2)
+14 IF $PIECE(IBY,U,5)
WRITE ?61,$$FORMAT($PIECE(IBY,U,5),12,2)
+15 SET IBTOT=IBTOT+$PIECE(IBY,U,3)
SET IBTOTS=IBTOTS+$PIECE(IBY,U,4)
SET IBTOTI=IBTOTI+$PIECE(IBY,U,5)
End DoDot:1
if IBQUIT
QUIT
+16 if IBQUIT
QUIT
+17 IF (IBTOT!IBTOTI)
DO TOTALS
+18 DO PAUSE(1)
+19 QUIT
+20 ;Number format
FORMAT(IBNUM,IBDIG,IBFRM) NEW X,X1,X2,X3
+1 SET X=IBNUM
SET X2=$GET(IBFRM,"2$")
SET X3=IBDIG
+2 DO COMMA^%DTC
+3 QUIT X
+4 ;
CHKSTOP IF $Y>(IOSL-5)
DO PAUSE(0)
if IBQUIT
QUIT
DO HDR
+1 QUIT
+2 ;
+3 ;
HDR ; Print header.
+1 NEW IBI
+2 IF $EXTRACT(IOST,1,2)["C-"!(IBPAG)
WRITE @IOF,*13
+3 SET IBH="GMT MONTHLY TOTALS REPORT"
+4 SET IBPAG=IBPAG+1
WRITE ?(70-$LENGTH(IBH)\2),IBH
+5 WRITE !,"From ",$$DAT(IBBDT)," through ",$$DAT(IBEDT)
+6 WRITE ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
+7 WRITE !!," MONTH",?10,"YEAR",?16,"# GMT PATIENTS ",?32,"GMT BILLED",?48,"GMT DIFF",?65,"PENDING"
+8 WRITE !
FOR IBI=1:1:80
WRITE "-"
+9 QUIT
+10 ;
TOTALS NEW IBI,X
+1 WRITE !,?30
FOR IBI=1:1:45
WRITE "-"
+2 WRITE !,?29,$$FORMAT(IBTOT,14),?44,$$FORMAT(IBTOTS,14),?59,$$FORMAT(IBTOTI,14)
+3 QUIT
+4 ;
STAT() ; Display bill number or status
+1 NEW IBSTAT
SET IBSTAT=$GET(^IBE(350.21,+$PIECE(IBZ,U,5),0))
+2 QUIT $SELECT($PIECE(IBSTAT,U,6):$$HLD(+$PIECE(IBZ,U,5)),$PIECE(IBZ,U,5)=99:"Converted",$PIECE(IBZ,U,11)]"":$PIECE($PIECE(IBZ,U,11),"-",2),$PIECE(IBSTAT,U,5):"Cancelled",1:"Pending")
+3 ;
HLD(STAT) ; Return an 'on hold' status string
+1 QUIT "Hold "_$SELECT(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
+2 ;
PAUSE(IBEND) ;
+1 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 NEW IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
+3 ;F IBJ=$Y:1:(IOSL-4) W !
WRITE !!
+4 SET DIR(0)="E"
+5 IF $GET(IBEND)
SET DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
+6 DO ^DIR
KILL DIR
IF $GET(DUOUT)
SET IBQUIT=1
WRITE @IOF
QUIT
+7 IF $GET(IBEND)
WRITE @IOF
+8 QUIT
+9 ;
DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
+1 QUIT $$FMTE^XLFDT(IBDT,"2MZ")
+2 ;
PLUS(IBDT,IBDAYS) NEW X,X1,X2
+1 SET X1=IBDT
SET X2=IBDAYS
+2 DO C^%DTC
+3 QUIT X
+4 ;
+5 ;Add the data to tmp global, if needed.
PROC(IBDA) NEW IBDTBT,IBMON,IBZ,IBY,IBDFN,IBSTA,IBCRG,IBSEQ,IBGMT
+1 SET IBZ=$GET(^IB(IBDA,0))
IF 'IBZ
QUIT
+2 ; ERROR charges will not be considered
SET IBSTA=$PIECE(IBZ,U,5)
IF IBSTA=9
QUIT
+3 ;Zero amount
SET IBCRG=$PIECE(IBZ,U,7)
IF 'IBCRG
QUIT
+4 if $PIECE(IBZ,U,8)["ADMISSION"
QUIT
+5 SET IBDTBT=$PIECE(IBZ,U,15)
if IBDTBT=""
SET IBDTBT=$PIECE(IBZ,U,14)
+6 SET IBDTBT=$PIECE(IBDTBT,".")
+7 ;"BILLED TO" date must be within the date range
if IBDTBT<IBBDT
QUIT
if IBDTBT>IBEDT
QUIT
+8 ; Do not include cancelled charges with no bill No.
+9 IF $PIECE(IBZ,U,11)=""
IF $PIECE($GET(^IBE(350.21,+$PIECE(IBZ,U,5),0)),U,5)
QUIT
+10 SET IBGMT=$PIECE(IBZ,U,21)
+11 SET IBSEQ=$PIECE($GET(^IBE(350.1,+$PIECE(IBZ,U,3),0)),U,5)
+12 ; Maybe the parent charge is GMT RELATED?
IF IBSEQ=2
IF 'IBGMT
IF $PIECE(IBZ,U,9)
SET IBGMT=$PIECE($GET(^IB(+$PIECE(IBZ,U,9),0)),U,21)
+13 ; The charge is not GMT RELATED.
if 'IBGMT
QUIT
+14 IF IBSEQ=2
SET IBCRG=-IBCRG
+15 ;Month
SET IBMON=$EXTRACT(IBDTBT,1,5)
+16 SET IBDFN=$PIECE(IBZ,U,2)
+17 ;Monthly statistics node
SET IBY=$GET(@IBTMP@("M",IBMON))
+18 ; Charge Counter
SET $PIECE(IBY,U,1)=$PIECE(IBY,U,1)+1
+19 ; Patient Counter
IF '$DATA(@IBTMP@("P",IBDFN,IBMON))
SET $PIECE(IBY,U,2)=$PIECE(IBY,U,2)+1
SET @IBTMP@("P",IBDFN,IBMON)=""
+20 ; GMT Charges Monthly Total
IF IBSTA'=1
SET $PIECE(IBY,U,3)=$PIECE(IBY,U,3)+IBCRG
+21 ; GMT Charges Monthly Difference
IF IBSTA'=1
SET $PIECE(IBY,U,4)=$PIECE(IBY,U,4)+(IBCRG*4)
+22 ; GMT Incompleted Charges Monthly Total
IF IBSTA=1
SET $PIECE(IBY,U,5)=$PIECE(IBY,U,5)+IBCRG
+23 SET @IBTMP@("M",IBMON)=IBY
+24 QUIT
MON(IBMON) IF (IBMON<1)!(IBMON>12)
QUIT ""
+1 QUIT $PIECE("JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"," ",IBMON)
+2 ;
