Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBAGMM1

IBAGMM1.m

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