- 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 Dec 13, 2024@02:06:18 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 ;