| 1 | IBOVOP2 ;ALB/CPM-Opt/Reg Events Report Print Utilities ; 30-AUG-93
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,132,153,156,167,176,234,247,339**;21-MAR-94;Build 2
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | PRINT ; Retrieve data for printing.
|
|---|
| 6 | N IBCOMBAT
|
|---|
| 7 | S IBFLD1="" I '$D(^TMP("IBOVOP",$J)) W !!,"No Outpatient activity recorded for MT/LTC copay patients on ",$$DAT1^IBOUTL(IBDATE),"."
|
|---|
| 8 | F S IBFLD1=$O(^TMP("IBOVOP",$J,IBFLD1)) Q:(IBFLD1="")!(IBQUIT) W ! D:IBLINE>55 HDR W !,IBFLD1 D D CHRGS Q:IBQUIT
|
|---|
| 9 | .S IBFLD2="" F S IBFLD2=$O(^TMP("IBOVOP",$J,IBFLD1,IBFLD2)) Q:(IBFLD2="")!(IBQUIT) D
|
|---|
| 10 | ..S IBFLD3="" F S IBFLD3=$O(^TMP("IBOVOP",$J,IBFLD1,IBFLD2,IBFLD3)) Q:(IBFLD3="")!(IBQUIT) D
|
|---|
| 11 | ...S IBSEQ="" F S IBSEQ=$O(^TMP("IBOVOP",$J,IBFLD1,IBFLD2,IBFLD3,IBSEQ)) Q:(IBSEQ="")!(IBQUIT) S IBDATA=$G(^(IBSEQ)) D
|
|---|
| 12 | ....S IBFLD4=$P(IBDATA,"^",1),IBFLD5=$P(IBDATA,"^",2),IBFLD6=$P(IBDATA,"^",3),DFN=$P(IBDATA,"^",4)
|
|---|
| 13 | ....S IBCOMBAT=$$CVEDT^IBACV(DFN,IBDATE) I +IBCOMBAT I $P(IBCOMBAT,"^",2)>0 W !,"Veteran has CV status until "_$$DAT1^IBOUTL($P(IBCOMBAT,"^",2))
|
|---|
| 14 | ....W !?5,IBFLD2
|
|---|
| 15 | ....W ?20,IBFLD3,?26,IBFLD4,?44,IBFLD5,?63,IBFLD6 D CLSF(+$P(IBDATA,"^",5)) D:IBFLD2="OBS ADMIS" CLSF^IBECEAU5(+$P(IBDATA,U,6)) W ! S IBLINE=IBLINE+1
|
|---|
| 16 | ....Q:$O(^TMP("IBOVOP",$J,IBFLD1))=""
|
|---|
| 17 | ....I IBLINE>55 D HDR W !,IBFLD1 I $D(^TMP("IBOVOP",$J,IBFLD1,IBFLD2,IBFLD3,IBSEQ+1)) W !?5,IBFLD2
|
|---|
| 18 | ....I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR W !,IBFLD1,!?5,IBFLD2
|
|---|
| 19 | D:'IBQUIT PAUSE^IBOUTL
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | CHRGS ; Find OP charges for day, if any. Build string for print.
|
|---|
| 23 | Q:'$G(DFN)
|
|---|
| 24 | N IBSTDATA
|
|---|
| 25 | I $D(^IB("AFDT",DFN,-IBDATE))=10 D
|
|---|
| 26 | .S IBPRNT="" F S IBPRNT=$O(^IB("AFDT",DFN,-IBDATE,IBPRNT)) Q:IBPRNT=""!(IBQUIT) D
|
|---|
| 27 | ..S IBIEN="" F S IBIEN=$O(^IB("AD",IBPRNT,IBIEN)) Q:IBIEN=""!(IBQUIT) D
|
|---|
| 28 | ...S IBDATA=$G(^IB(IBIEN,0)) Q:IBDATA=""
|
|---|
| 29 | ...I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR W !,IBFLD1
|
|---|
| 30 | ...S IBSTAT=$P($G(^IBE(350.21,+$P(IBDATA,"^",5),0)),"^",2)
|
|---|
| 31 | ...S IBACT=$S($P($G(^IBE(350.1,+$P(IBDATA,"^",3),0)),"^",8)'="":$P(^(0),"^",8),1:$P(^(0),"^",1))
|
|---|
| 32 | ...S IBAMT=$P(IBDATA,"^",7)
|
|---|
| 33 | ...S IBAMT=$S(IBAMT?1N.N1"."1N:IBAMT_"0 ",IBAMT?1N.N:IBAMT_".00 ",1:IBAMT)
|
|---|
| 34 | ...S IBAMT=$S(IBACT["CANCEL":"*($"_IBAMT_")",1:"* $"_IBAMT)
|
|---|
| 35 | ...S IBSTDATA=$G(^IBE(352.5,+$P(IBDATA,"^",20),0))
|
|---|
| 36 | ...I IBSTDATA'="" W !?26,"Stop Code: ",$P(IBSTDATA,"^",4),?58,"#",$P(IBSTDATA,"^"),?63,$$TYPE^IBEMTSCR(+$P(IBSTDATA,"^",3))
|
|---|
| 37 | ...W !?5,IBAMT,?13,IBACT,?63,IBSTAT S IBLINE=IBLINE+1
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | HDR ; Print header.
|
|---|
| 41 | S IBPAGE=IBPAGE+1,IBLINE=5,IBTITLE="Means Test/LTC Outpatient and Registration Activity for "_$$DAT1^IBOUTL(IBDATE)
|
|---|
| 42 | I $E(IOST,1,2)["C-"!(IBPAGE>1) W @IOF,*13
|
|---|
| 43 | W ?(80-$L(IBTITLE))\2,IBTITLE
|
|---|
| 44 | S IBTITLE="Printed: "_$$DAT1^IBOUTL(DT)
|
|---|
| 45 | W !?(80-$L(IBTITLE))\2,IBTITLE,?70,"Page: "_IBPAGE
|
|---|
| 46 | W !!,"Patient/Event",?20,"Time",?26,"Clinic/Stop",?44,"Appt.Type",?63,"(Status)",!
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | CLSF(IBOE) ; Display classification results.
|
|---|
| 50 | ; Input: IBOE -- Pointer to Outpatient Encounter in file #409.68
|
|---|
| 51 | I '$G(IBOE) G CLSFQ
|
|---|
| 52 | N I,IBCLS,IBCLSD,IBF S IBF=0,IBCLSD=$$ENCL^IBAMTS2(IBOE)
|
|---|
| 53 | I IBCLSD]"" F I=1,2,3,4,5,6,7,8 S IBCLS=$P(IBCLSD,"^",I) I IBCLS]"" W:'IBF !?6 W:IBF " " W "Care related to ",$S(I=1:"AO",I=2:"IR",I=3:"SC",I=4:"SWA",I=5:"MST",I=6:"HNC",I=7:"CV",I=8:"SHAD",1:"??"),"? ",$S(IBCLS:"YES",1:"NO") S IBF=1
|
|---|
| 54 | CLSFQ Q
|
|---|
