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

IBEMTF2.m

Go to the documentation of this file. 
  1. IBEMTF2	;ALB/CPM - LIST NON-BILLABLE STOP CODES, DISPOSITIONS, AND CLINICS ; 05-AUG-93
  1. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. 	;
  1. EN	; Option entry point - describe output.
  1. 	W !!?5,"This report may be used to generate a list of all clinic stop codes,"
  1. 	W !?5,"dispositions, and clinics where Means Test billing will be ignored.",!
  1. 	;
  1. 	; - grab effective date
  1. 	S %DT="AEX",%DT("A")="Please select the effective date for this list: ",%DT("B")=$$DAT2^IBOUTL(DT)
  1. 	D ^%DT K %DT G:Y<0 ENQ S IBDAT=Y
  1. 	;
  1. 	; - select a device
  1. 	S %ZIS="QM" D ^%ZIS G:POP ENQ
  1. 	I $D(IO("Q")) D  G ENQ
  1. 	.S ZTRTN="DQ^IBEMTF2",ZTDESC="LIST NON-BILLABLE STOPS/CLINICS/DISPOSITIONS",ZTSAVE("IBDAT")=""
  1. 	.D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued.  The task number is "_ZTSK_".",1:"Unable to queue this job.")
  1. 	.K ZTSK,IO("Q") D HOME^%ZIS
  1. 	;
  1. 	U IO
  1. 	;
  1. DQ	; Tasked entry point.
  1. 	;
  1. 	; - compile data
  1. 	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)=""
  1. 	;
  1. 	; - print results
  1. 	S (IBPAG,IBQ)=0 F IBI=352.2,352.3,352.4 D HDR,LST,PAUSE:'IBQ Q:IBQ
  1. 	;
  1. ENQ	I '$D(ZTQUEUED) D ^%ZISC
  1. 	K IBDAT,IBI,IBJ,IBQ,IBT,IBPAG
  1. ENQ1	K ^TMP("IBEMTF2",$J)
  1. 	Q
  1. 	;
  1. HDR	; Generate a report header.
  1. 	I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
  1. 	S IBPAG=IBPAG+1,IBT="LIST OF NON-BILLABLE "_$S(IBI=352.2:"DISPOSITIONS",IBI=352.3:"CLINIC STOP CODES",1:"CLINICS")
  1. 	W $$DASH(),!?(80-$L(IBT)\2),IBT,!?33,"As Of: ",$$DAT1^IBOUTL(IBDAT)
  1. 	W !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
  1. 	W !,$$DASH(),!!
  1. 	Q
  1. 	;
  1. LST	; List all selected entries.
  1. 	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
  1. 	S IBJ=0 F  S IBJ=$O(^TMP("IBEMTF2",$J,IBI,IBJ)) Q:'IBJ  D  Q:IBQ
  1. 	.W:$X>40 ! I $Y>(IOSL-3) D PAUSE Q:IBQ  D HDR
  1. 	.W:$X>2 ?40 W $$VAL(IBI,IBJ)
  1. LSTQ	Q
  1. 	;
  1. NBILL(IBF,IBEN,IBD)	; Is the entry not billable as of the effective date?
  1. 	;  Input:    IBF  --  Base file (#352.2, #352.3, #352.4)
  1. 	;           IBEN  --  Internal entry number for entry
  1. 	;            IBD  --  Effective date for non-billing
  1. 	N Y S Y=0
  1. 	I '$G(IBF)!'$G(IBEN)!'$G(IBD) G NBILLQ
  1. 	I $G(IBF)=352.2 S Y=$$NBDIS^IBEFUNC(IBEN,IBDAT) G NBILLQ
  1. 	I $G(IBF)=352.3 S Y=$$NBCSC^IBEFUNC(IBEN,IBDAT) G NBILLQ
  1. 	I $G(IBF)=352.4 S Y=$$NBCL^IBEFUNC(IBEN,IBDAT)
  1. NBILLQ	Q Y
  1. 	;
  1. VAL(IBF,IBEN)	; Return the entry name.
  1. 	;  Input:    IBF  --  Base file (#352.2, #352.3, #352.4)
  1. 	;           IBEN  --  Internal entry number for entry
  1. 	;  Output:    Entry name (#.01 from respective file)
  1. 	N Y S Y="'ENTRY NAME UNKNOWN'"
  1. 	I '$G(IBF)!'$G(IBEN) G VALQ
  1. 	I $G(IBF)=352.2 S Y=$P($G(^DIC(37,IBEN,0)),"^") G VALQ
  1. 	I $G(IBF)=352.3 S Y=$P($G(^DIC(40.7,IBEN,0)),"^") G VALQ
  1. 	I $G(IBF)=352.4 S Y=$P($G(^SC(IBEN,0)),"^")
  1. VALQ	Q Y
  1. 	;
  1. DASH()	; Return a dashed line.
  1. 	Q $TR($J("",80)," ","=")
  1. 	;
  1. PAUSE	; Page break
  1. 	Q:$E(IOST,1,2)'="C-"
  1. 	N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1. 	F IBX=$Y:1:(IOSL-3) W !
  1. 	S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
  1. 	Q