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

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1IBEMTF2 ;ALB/CPM - LIST NON-BILLABLE STOP CODES, DISPOSITIONS, AND CLINICS ; 05-AUG-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; Option entry point - describe output.
6 W !!?5,"This report may be used to generate a list of all clinic stop codes,"
7 W !?5,"dispositions, and clinics where Means Test billing will be ignored.",!
8 ;
9 ; - grab effective date
10 S %DT="AEX",%DT("A")="Please select the effective date for this list: ",%DT("B")=$$DAT2^IBOUTL(DT)
11 D ^%DT K %DT G:Y<0 ENQ S IBDAT=Y
12 ;
13 ; - select a device
14 S %ZIS="QM" D ^%ZIS G:POP ENQ
15 I $D(IO("Q")) D G ENQ
16 .S ZTRTN="DQ^IBEMTF2",ZTDESC="LIST NON-BILLABLE STOPS/CLINICS/DISPOSITIONS",ZTSAVE("IBDAT")=""
17 .D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
18 .K ZTSK,IO("Q") D HOME^%ZIS
19 ;
20 U IO
21 ;
22DQ ; Tasked entry point.
23 ;
24 ; - compile data
25 D ENQ1 F IBI=352.2,352.3,352.4 S IBJ=0 F S IBJ=$O(^IBE(IBI,"AIVDT",IBJ)) Q:'IBJ I $$NBILL(IBI,IBJ,IBDAT) S ^TMP("IBEMTF2",$J,IBI,IBJ)=""
26 ;
27 ; - print results
28 S (IBPAG,IBQ)=0 F IBI=352.2,352.3,352.4 D HDR,LST,PAUSE:'IBQ Q:IBQ
29 ;
30ENQ I '$D(ZTQUEUED) D ^%ZISC
31 K IBDAT,IBI,IBJ,IBQ,IBT,IBPAG
32ENQ1 K ^TMP("IBEMTF2",$J)
33 Q
34 ;
35HDR ; Generate a report header.
36 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
37 S IBPAG=IBPAG+1,IBT="LIST OF NON-BILLABLE "_$S(IBI=352.2:"DISPOSITIONS",IBI=352.3:"CLINIC STOP CODES",1:"CLINICS")_" FOR MEANS TEST BILLING"
38 W $$DASH(),!?(80-$L(IBT)\2),IBT,!?33,"As Of: ",$$DAT1^IBOUTL(IBDAT)
39 W !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
40 W !,$$DASH(),!!
41 Q
42 ;
43LST ; List all selected entries.
44 I '$D(^TMP("IBEMTF2",$J,IBI)) W "All ",$S(IBI=352.2:"dispositions",IBI=352.3:"clinic stop codes",1:"clinics")," are billable on this date." G LSTQ
45 S IBJ=0 F S IBJ=$O(^TMP("IBEMTF2",$J,IBI,IBJ)) Q:'IBJ D Q:IBQ
46 .W:$X>40 ! I $Y>(IOSL-3) D PAUSE Q:IBQ D HDR
47 .W:$X>2 ?40 W $$VAL(IBI,IBJ)
48LSTQ Q
49 ;
50NBILL(IBF,IBEN,IBD) ; Is the entry not billable as of the effective date?
51 ; Input: IBF -- Base file (#352.2, #352.3, #352.4)
52 ; IBEN -- Internal entry number for entry
53 ; IBD -- Effective date for non-billing
54 N Y S Y=0
55 I '$G(IBF)!'$G(IBEN)!'$G(IBD) G NBILLQ
56 I $G(IBF)=352.2 S Y=$$NBDIS^IBEFUNC(IBEN,IBDAT) G NBILLQ
57 I $G(IBF)=352.3 S Y=$$NBCSC^IBEFUNC(IBEN,IBDAT) G NBILLQ
58 I $G(IBF)=352.4 S Y=$$NBCL^IBEFUNC(IBEN,IBDAT)
59NBILLQ Q Y
60 ;
61VAL(IBF,IBEN) ; Return the entry name.
62 ; Input: IBF -- Base file (#352.2, #352.3, #352.4)
63 ; IBEN -- Internal entry number for entry
64 ; Output: Entry name (#.01 from respective file)
65 N Y S Y="'ENTRY NAME UNKNOWN'"
66 I '$G(IBF)!'$G(IBEN) G VALQ
67 I $G(IBF)=352.2 S Y=$P($G(^DIC(37,IBEN,0)),"^") G VALQ
68 I $G(IBF)=352.3 S Y=$P($G(^DIC(40.7,IBEN,0)),"^") G VALQ
69 I $G(IBF)=352.4 S Y=$P($G(^SC(IBEN,0)),"^")
70VALQ Q Y
71 ;
72DASH() ; Return a dashed line.
73 Q $TR($J("",80)," ","=")
74 ;
75PAUSE ; Page break
76 Q:$E(IOST,1,2)'="C-"
77 N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
78 F IBX=$Y:1:(IOSL-3) W !
79 S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
80 Q
Note: See TracBrowser for help on using the repository browser.