source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOVOP2.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1IBOVOP2 ;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 ;
5PRINT ; 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 ;
22CHRGS ; 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 ;
40HDR ; 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 ;
49CLSF(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
54CLSFQ Q
Note: See TracBrowser for help on using the repository browser.