| 1 | IBAECP1 ;WOIFO/AAT-LTC SINGLE PATIENT PROFILE ; 20-FEB-02
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**176**;21-MAR-94
|
|---|
| 3 | ;; Per VHA Directive 10-93-142, this routine should not be modified
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | ; Prints report to the current device
|
|---|
| 8 | ;
|
|---|
| 9 | ; Input:
|
|---|
| 10 | ; IBDFN - Patient IEN
|
|---|
| 11 | ; IBCLK - LTC Copay Billing Clock IEN
|
|---|
| 12 | ; IBDT1 - Beginning date
|
|---|
| 13 | ; IBDT2 - Ending date
|
|---|
| 14 | ; IBOFD - Option: print free (exempt) days list
|
|---|
| 15 | ; IBOEV - Option: print LTC events
|
|---|
| 16 | ; Output:
|
|---|
| 17 | ; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
|
|---|
| 18 | REPORT ;
|
|---|
| 19 | N IBDT,IBDTE,IBDTH,IBCR,IBDA,IBX,IBAT,IBTMP,IBZ,IBCL
|
|---|
| 20 | S IBQUIT=0
|
|---|
| 21 | S IBTMP=$NA(^TMP($J,"IBAECP")) ; The node of TMP array
|
|---|
| 22 | K @IBTMP
|
|---|
| 23 | ;
|
|---|
| 24 | ; Marking beginning and ending of each clock within the range.
|
|---|
| 25 | ; Not including selected LTC BILLING CLOCK
|
|---|
| 26 | S IBDT=0 F D Q:'IBDT Q:IBDT>IBDT2
|
|---|
| 27 | . S IBDT=$O(^IBA(351.81,"AE",IBDFN,IBDT)) Q:'IBDT
|
|---|
| 28 | . S IBCL=0 F D Q:'IBCL
|
|---|
| 29 | .. S IBCL=$O(^IBA(351.81,"AE",IBDFN,IBDT,IBCL)) Q:'IBCL
|
|---|
| 30 | .. Q:IBCL=IBCLK ; Don't include the selected clock to the report
|
|---|
| 31 | .. S IBZ=$G(^IBA(351.81,IBCL,0)) Q:IBZ=""
|
|---|
| 32 | .. I $P(IBZ,U,5)=3 Q ; Status - FOR CANCELLED
|
|---|
| 33 | .. I IBDT'<IBDT1,IBDT'>IBDT2 S @IBTMP@(IBDT,"C")=IBCL ; Mark the beginning of the clock
|
|---|
| 34 | .. S IBDTE=$P(+$P(IBZ,U,4),".")
|
|---|
| 35 | .. I IBDTE,IBDTE'<IBDT1,IBDTE'>IBDT2 S @IBTMP@(IBDTE,"E")=IBCL ; Mark the ending of the clock
|
|---|
| 36 | ;
|
|---|
| 37 | ;
|
|---|
| 38 | ; Get the charges from file #350.
|
|---|
| 39 | S IBDT="" F S IBDT=$O(^IB("AFDT",IBDFN,IBDT)) Q:'IBDT D:-IBDT'>IBDT2
|
|---|
| 40 | . S IBCR=0 F S IBCR=$O(^IB("AFDT",IBDFN,IBDT,IBCR)) Q:'IBCR D
|
|---|
| 41 | .. S IBDA=0 F S IBDA=$O(^IB("AF",IBCR,IBDA)) Q:'IBDA D
|
|---|
| 42 | ... Q:'$D(^IB(IBDA,0)) S IBX=^(0)
|
|---|
| 43 | ... ;;; Q:$P(IBX,U,8)["ADMISSION" ; Not sure it is needed
|
|---|
| 44 | ... I $P(IBX,U,15)<IBDT1 Q
|
|---|
| 45 | ... I $P(IBX,U,14)>IBDT2 Q
|
|---|
| 46 | ... S IBAT=$P(IBX,U,3) Q:'IBAT ; Action type is really required
|
|---|
| 47 | ... I $$ACTNM^IBOUTL(IBAT)'["LTC " Q ; Not an LTC action type
|
|---|
| 48 | ... S @IBTMP@(+$P(IBX,U,14),"I"_IBDA)=""
|
|---|
| 49 | ;
|
|---|
| 50 | D PRINT
|
|---|
| 51 | K @IBTMP ; Kill the global node
|
|---|
| 52 | K ^TMP($J,"180DAYS")
|
|---|
| 53 | K ^TMP($J,"IBMJINP")
|
|---|
| 54 | K ^TMP($J,"IBMJOUT")
|
|---|
| 55 | S:$D(ZTQUEUED) ZTREQ="@" ; for Taskman
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | PRINT ; Print report from the temp. global
|
|---|
| 59 | N IBLINE,IBPAG,IBTOT,IBTOTM,IBTOTP,IBPT,IBH,IBD,IBTY,IBDA,IBDZ,IBCHG,IBSEQ,X,X2,X3,Y,%,IBCURM,IBCURY,IBCIS
|
|---|
| 60 | D NOW^%DTC S IBDTH=$$FMTE^XLFDT($E(%,1,12))
|
|---|
| 61 | S IBLINE="",$P(IBLINE,"=",IOM+1)="",(IBPAG,IBTOT,IBTOTM,IBQUIT,IBCHG,IBTOTP)=0
|
|---|
| 62 | S IBPT=$$PT^IBEFUNC(IBDFN)
|
|---|
| 63 | S IBCIS=0
|
|---|
| 64 | S IBH="LTC Billing Profile for "_$P(IBPT,U)_" "_$P(IBPT,U,2) D HDR
|
|---|
| 65 | ;;; D CLKINFO ; Print brief clock info
|
|---|
| 66 | I '$D(@IBTMP) W !!,"The patient has no LTC bills within the specified period" D PAUSE(1) Q
|
|---|
| 67 | S (IBCURM,IBCURY)=0 ; Current month and year
|
|---|
| 68 | ; - first, print detail lines
|
|---|
| 69 | S IBD="" F S IBD=$O(@IBTMP@(IBD)) Q:'IBD D Q:IBQUIT
|
|---|
| 70 | . S IBTY="" F S IBTY=$O(@IBTMP@(IBD,IBTY)) Q:IBTY="" D Q:IBQUIT
|
|---|
| 71 | .. D CHKSTOP Q:IBQUIT
|
|---|
| 72 | .. I (+$E(IBD,4,5)'=IBCURM)!(+$E(IBD,1,3)'=IBCURY) D MONTOTAL
|
|---|
| 73 | .. I IBTY="C" W !,$$DAT(IBD),?18,"Start another LTC Copay Clock" Q
|
|---|
| 74 | .. I IBTY="E" W !,$$DAT(IBD),?18,"Expire another LTC Copay Clock" Q
|
|---|
| 75 | .. ; If the month has been changed
|
|---|
| 76 | .. I +$E(IBD,4,5)'=IBCURM D PRMON(IBD) S IBTOTM=0 ; Monthly total
|
|---|
| 77 | .. W !,$$DAT(IBD)
|
|---|
| 78 | .. S IBDA=+$E(IBTY,2,99),IBDZ=$G(^IB(IBDA,0)),IBSEQ=0
|
|---|
| 79 | .. I $P(IBDZ,U,14)'=$P(IBDZ,U,15) W ?12,$$DAT($P(IBDZ,U,15))
|
|---|
| 80 | .. S IBSEQ=$P($G(^IBE(350.1,+$P(IBDZ,U,3),0)),U,5)
|
|---|
| 81 | .. W ?24,$$ACTNM^IBOUTL(+$P(IBDZ,U,3))
|
|---|
| 82 | .. W ?54,$$STAT()
|
|---|
| 83 | .. S IBCHG=+$P(IBDZ,U,7)
|
|---|
| 84 | .. I IBSEQ=2 S IBCHG=-IBCHG
|
|---|
| 85 | .. I $P(IBDZ,U,11)="",$P($G(^IBE(350.21,+$P(IBDZ,U,5),0)),U,5) S IBCHG=0
|
|---|
| 86 | .. S X=IBCHG,X2="2$",X3=10 D COMMA^%DTC W ?65,X
|
|---|
| 87 | .. S IBTOT=IBTOT+IBCHG ; Total
|
|---|
| 88 | .. S IBTOTM=IBTOTM+IBCHG ; Monthly total
|
|---|
| 89 | .. I IBSEQ=2!($P(IBDZ,U,11)=""&($P($G(^IBE(350.21,+$P(IBDZ,U,5),0)),U,5))) W !?5,"Charge Removal Reason: ",$S($D(^IBE(350.3,+$P(IBDZ,U,10),0)):$P(^(0),U),1:"UNKNOWN")
|
|---|
| 90 | .. S IBTOTP=1
|
|---|
| 91 | Q:IBQUIT
|
|---|
| 92 | D MONTOTAL
|
|---|
| 93 | D PAUSE(1)
|
|---|
| 94 | Q
|
|---|
| 95 | CHKSTOP I $Y>(IOSL-5) D PAUSE(0) Q:IBQUIT D HDR
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | ;
|
|---|
| 99 | ; Print month header
|
|---|
| 100 | PRMON(IBDT) ;
|
|---|
| 101 | S IBCURM=+$E(IBDT,4,5)
|
|---|
| 102 | S IBCURY=+$E(IBDT,1,3)
|
|---|
| 103 | W !,"LTC CHARGES FOR ",$$MONNAM(IBCURM)," ",IBCURY+1700
|
|---|
| 104 | ;
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | MONNAM(IBM) ;Name of the month by number
|
|---|
| 108 | Q $P("JANUARY;FEBRUARY;MARCH;APRIL;MAY;JUNE;JULY;AUGUST;SEPTEMBER;OCTOBER;NOVEMBER;DECEMBER",";",IBM)
|
|---|
| 109 | ;
|
|---|
| 110 | ; Totals for the month (and monthly cap)
|
|---|
| 111 | MONTOTAL N X,X2,X3,IBDTM1,IBDTM2,IBCAP
|
|---|
| 112 | Q:'IBTOTP
|
|---|
| 113 | D CHKSTOP Q:IBQUIT
|
|---|
| 114 | W !?65,"---------"
|
|---|
| 115 | D CHKSTOP Q:IBQUIT
|
|---|
| 116 | K ^TMP($J,"180DAYS")
|
|---|
| 117 | K ^TMP($J,"IBMJINP")
|
|---|
| 118 | K ^TMP($J,"IBMJOUT")
|
|---|
| 119 | S IBDTM1=IBCURY_$S(IBCURM>10:IBCURM,1:"0"_IBCURM)_"01" ; First day of month
|
|---|
| 120 | S IBDTM2=$$LASTDT^IBAECU(IBDTM1) ; Last day of month
|
|---|
| 121 | I $$INPINFO^IBAECU2(IBDTM1,IBDTM2,IBDFN,"IBMJINP",1) ;"no inpatient stay"
|
|---|
| 122 | I $$OUTPINFO^IBAECU3(IBDTM1,IBDTM2,IBDFN,"IBMJOUT") ;"no outpatient visits"
|
|---|
| 123 | S IBCAP=$$CLCK180^IBAECM2(IBDFN,IBDTM1,IBDTM2,"IBMJINP")
|
|---|
| 124 | ;
|
|---|
| 125 | W !?5,"Monthly LTC Copay Cap: " S X=+IBCAP,X2="2$",X3=12 D COMMA^%DTC W ?25,X
|
|---|
| 126 | ; Indicate 1-180 of 180+ flag
|
|---|
| 127 | W " (",$S('$P(IBCAP,U,2):"1-180 days",1:"181+ days"),") "
|
|---|
| 128 | S X=IBTOTM,X2="2$",X3=12 D COMMA^%DTC W ?63,X
|
|---|
| 129 | I IBOEV D EVENTS
|
|---|
| 130 | S IBCURM=0 ; Set current month to unknown
|
|---|
| 131 | S IBTOTP=0
|
|---|
| 132 | W !
|
|---|
| 133 | Q
|
|---|
| 134 | ;
|
|---|
| 135 | HDR ; Print header.
|
|---|
| 136 | N IBI
|
|---|
| 137 | I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
|
|---|
| 138 | S IBPAG=IBPAG+1 W ?(80-$L(IBH)\2),IBH
|
|---|
| 139 | W !,"From ",$$DAT(IBDT1)," through ",$$DAT(IBDT2)
|
|---|
| 140 | W ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
|
|---|
| 141 | I 'IBCIS S IBCIS=1 D CLKINFO ; Print brief clock info
|
|---|
| 142 | W !,"BILL DATE BILL TO BILL TYPE",?55,"BILL # TOT CHARGE"
|
|---|
| 143 | W ! F IBI=1:1:80 W "-"
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
| 146 | STAT() ; Display bill number or status
|
|---|
| 147 | N IBSTAT S IBSTAT=$G(^IBE(350.21,+$P(IBDZ,U,5),0))
|
|---|
| 148 | Q $S($P(IBSTAT,U,6):$$HLD(+$P(IBDZ,U,5)),$P(IBDZ,U,5)=99:"Converted",$P(IBDZ,U,11)]"":$P($P(IBDZ,U,11),"-",2),$P(IBSTAT,U,5):"Cancelled",1:"Pending")
|
|---|
| 149 | ;
|
|---|
| 150 | HLD(STAT) ; Return an 'on hold' status string
|
|---|
| 151 | Q "Hold "_$S(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
|
|---|
| 152 | ;
|
|---|
| 153 | PAUSE(IBEND) ;
|
|---|
| 154 | Q:$E(IOST,1,2)'["C-"
|
|---|
| 155 | N IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
|
|---|
| 156 | W !! ;F IBJ=$Y:1:(IOSL-4) W !
|
|---|
| 157 | S DIR(0)="E"
|
|---|
| 158 | I $G(IBEND) S DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
|
|---|
| 159 | D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
|
|---|
| 160 | I $G(IBEND) W @IOF
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
|
|---|
| 164 | Q $$FMTE^XLFDT(IBDT,"2MZ")
|
|---|
| 165 | ;
|
|---|
| 166 | ;For debugging only - find LTC-related records of the file #350
|
|---|
| 167 | FNDLTC N IEN,IBX,IBN
|
|---|
| 168 | S IEN=0 F S IEN=$O(^IB(IEN)) Q:'IEN D
|
|---|
| 169 | . Q:'$D(^IB(IEN,0)) S IBX=^(0)
|
|---|
| 170 | . ;;; Q:$P(IBX,U,8)["ADMISSION" ; Not sure it is needed
|
|---|
| 171 | . S IBN=$$ACTNM^IBOUTL(+$P(IBX,U,3))
|
|---|
| 172 | . I IBN["LTC " W !,IEN,?10,IBN ; Not an LTC action type
|
|---|
| 173 | W !,"Ready"
|
|---|
| 174 | Q
|
|---|
| 175 | ;
|
|---|
| 176 | CLKINFO ; Output short information about the clock
|
|---|
| 177 | N IBZ,IBDT1,IBDT2,IBV,IBC,IBI,IBA,IBN
|
|---|
| 178 | S IBZ=$G(^IBA(351.81,IBCLK,0)) I IBZ="" W !,"Corrupted record of LTC clock ",IBCLK Q
|
|---|
| 179 | S IBDT1=$P(IBZ,U,3)
|
|---|
| 180 | S IBDT2=$P(IBZ,U,4)
|
|---|
| 181 | S IBC=0 ; Counter of free days
|
|---|
| 182 | ; Collect an array of free days:
|
|---|
| 183 | S IBI=0 F S IBI=$O(^IBA(351.81,IBCLK,1,IBI)) Q:'IBI I $P(^(IBI,0),U,2) S IBC=IBC+1,IBA(IBC)=$P(^(0),U,2)
|
|---|
| 184 | W !,IBLINE
|
|---|
| 185 | W !?2,"LTC Copay Clock Start Date: ",$$DAT(IBDT1)
|
|---|
| 186 | W ?50,"Clock Status: ",$$EXTERNAL^DILFD(351.81,.05,"",$P(IBZ,U,5))
|
|---|
| 187 | I IBDT2 W !?2,"LTC Copay Clock End Date: ",$S(IBDT2:$$DAT(IBDT2),1:"none")
|
|---|
| 188 | D:IBOFD
|
|---|
| 189 | . W !?2,"Days Not Subject To LTC Copay:" I 'IBC W " none" Q
|
|---|
| 190 | . S IBV=IBC\3 I IBC#3 S IBV=IBV+1
|
|---|
| 191 | . F IBI=1:1:IBV D
|
|---|
| 192 | .. S IBN=IBI W !?5,$J(IBN,2),?10,$$FMTE^XLFDT(IBA(IBN))
|
|---|
| 193 | .. S IBN=IBI+IBV I $G(IBA(IBN)) W ?30,$J(IBN,2),?35,$$FMTE^XLFDT(IBA(IBN))
|
|---|
| 194 | .. S IBN=IBI+(2*IBV) I $G(IBA(IBN)) W ?55,$J(IBN,2),?60,$$FMTE^XLFDT(IBA(IBN))
|
|---|
| 195 | W !!
|
|---|
| 196 | Q
|
|---|
| 197 | ;
|
|---|
| 198 | ; Print LTC Events
|
|---|
| 199 | ; Input:
|
|---|
| 200 | ; IBDFN - Patient DFN
|
|---|
| 201 | ; IBDTM1,IBDTM2 - First/Last days of the month, FM format
|
|---|
| 202 | ; ^TMP($J,"IBMJINP"),^TMP($J,"IBMJOUT") with prepared data
|
|---|
| 203 | ; Output:
|
|---|
| 204 | ; Prints LTC Events report section
|
|---|
| 205 | EVENTS N IBA,IBMOV,IBNDX,IBDAY,IBSL,IBCR,IBZ,IBZCR,IBENC,IBCNT
|
|---|
| 206 | ; Collect data from ^TMP($J) array
|
|---|
| 207 | S IBNDX="IBMJINP" ; Inpatient part
|
|---|
| 208 | S IBMOV=0 F S IBMOV=$O(^TMP($J,IBNDX,IBDFN,IBMOV)) Q:'IBMOV D
|
|---|
| 209 | . F IBSL="SD","LD" D
|
|---|
| 210 | .. S IBCR=0 ; Current event begining day
|
|---|
| 211 | .. S IBDAY=0 F S IBDAY=$O(^TMP($J,IBNDX,IBDFN,IBMOV,IBSL,IBDAY)) Q:'IBDAY S IBZ=^(IBDAY) D:$P(IBZ,U)'="M" ; No means-test events
|
|---|
| 212 | ... I 'IBCR S IBCR=IBDAY,IBA(IBCR)=$E(IBDAY,6,7)_U_$E(IBSL)_U_IBZ
|
|---|
| 213 | ... ; I IBZCR'="",IBZCR'=IBZ S
|
|---|
| 214 | ... Q:($O(^TMP($J,IBNDX,IBDFN,IBMOV,IBSL,IBDAY))-1)=IBDAY
|
|---|
| 215 | ... S $P(IBA(IBCR),U)=$E(IBDAY,6,7) ; Days only
|
|---|
| 216 | ... S IBCR=0,IBZCR=""
|
|---|
| 217 | ;
|
|---|
| 218 | S IBNDX="IBMJOUT" ; Outpatient part
|
|---|
| 219 | S IBDAY=0 F S IBDAY=$O(^TMP($J,IBNDX,IBDFN,IBDAY)) Q:'IBDAY D
|
|---|
| 220 | . S IBCNT=0
|
|---|
| 221 | . S IBENC=0 F IBENC=$O(^TMP($J,IBNDX,IBDFN,IBDAY,IBENC)) Q:'IBENC S IBZ=^(IBENC) D:$P(IBZ,U)'="M" ; No means-test events
|
|---|
| 222 | .. S IBA(IBDAY)="O"
|
|---|
| 223 | .. S IBCNT=IBCNT+1
|
|---|
| 224 | .. S IBA(IBDAY,IBCNT)=IBZ
|
|---|
| 225 | ;
|
|---|
| 226 | W !?5,"Monthly LTC Events:"
|
|---|
| 227 | S IBDAY=0 F S IBDAY=$O(IBA(IBDAY)) Q:'IBDAY D Q:IBQUIT
|
|---|
| 228 | . I IBA(IBDAY)="O" D Q ; Outpatient events
|
|---|
| 229 | .. S IBCNT=0 F S IBCNT=$O(IBA(IBDAY,IBCNT)) Q:'IBCNT D Q:IBQUIT
|
|---|
| 230 | ... D CHKSTOP Q:IBQUIT
|
|---|
| 231 | ... W !?7,$$DAT(IBDAY),?30,$$ACTNM^IBOUTL($P(IBA(IBDAY,IBCNT),U,4))
|
|---|
| 232 | . ; Inpatient events
|
|---|
| 233 | . S IBZ=IBA(IBDAY)
|
|---|
| 234 | . D CHKSTOP Q:IBQUIT
|
|---|
| 235 | . W !?7,$$DAT(IBDAY) I $P(IBZ,U)'=$E(IBDAY,6,7) W " - ",?18,$$DAT($E(IBDAY,1,5)_$P(IBZ,U))
|
|---|
| 236 | . I $P(IBZ,U,2)="L" W ?30,"ABSENT DAYS" Q
|
|---|
| 237 | . W ?30,$$ACTNM^IBOUTL(+$P(IBZ,U,6))
|
|---|
| 238 | Q
|
|---|
