IBEPTC2 ;ALB/CPM/ARH - TP LIST NON-BILLABLE STOP CODES AND CLINICS ; 05-AUG-93
;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; Option entry point - describe output.
W !!?5,"This report may be used to generate a list of all clinic stop codes,"
W !?5,"and clinics that are non-billable in Third Party Billing or "
W !,?5,"that will not have bills created by the Third Party Auto Biller.",!
;
; - grab effective date
S %DT="AEX",%DT("A")="Please select the effective date for this list: ",%DT("B")=$$DAT2^IBOUTL(DT)
D ^%DT K %DT G:Y<0 ENQ S IBDAT=Y
;
; - select a device
S %ZIS="QM" D ^%ZIS G:POP ENQ
I $D(IO("Q")) D G ENQ
.S ZTRTN="DQ^IBEPTC2",ZTDESC="LIST NON-BILLABLE STOPS/CLINICS",ZTSAVE("IBDAT")=""
.D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,IO("Q") D HOME^%ZIS
;
U IO
;
DQ ; Tasked entry point.
;
; - compile data
D ENQ1 F IBI=352.3,352.4 S IBJ=0 F S IBJ=$O(^IBE(IBI,"AIVDTT2",IBJ)) Q:'IBJ D
. S IBX=$$NBILL(IBI,IBJ,IBDAT)
. I +IBX S ^TMP("IBEPTC2",$J,IBI,1,$$VAL(IBI,IBJ)_IBJ)=IBJ Q
. I +$P(IBX,U,2) S ^TMP("IBEPTC2",$J,IBI,2,$E($$VAL(IBI,IBJ),1,20)_IBJ)=IBJ
;
; - print results
S (IBPAG,IBQ)=0 F IBI=352.3,352.4 D HDR,LST,PAUSE:'IBQ Q:IBQ
;
ENQ I '$D(ZTQUEUED) D ^%ZISC
K IBDAT,IBI,IBJ,IBQ,IBT,IBPAG
ENQ1 K ^TMP("IBEPTC2",$J)
Q
;
HDR ; Generate a report header.
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
S IBPAG=IBPAG+1,IBT="LIST OF "_$S(IBI=352.3:"CLINIC STOP CODES",1:"CLINICS")_" FLAGGED FOR THIRD PARTY BILLING"
W $$DASH(),!?(80-$L(IBT)\2),IBT,!?33,"As Of: ",$$DAT1^IBOUTL(IBDAT)
W !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
W !,$$DASH(),!
Q
;
LST ; List all selected entries.
I '$D(^TMP("IBEPTC2",$J,IBI)) W "All ",$S(IBI=352.3:"clinic stop codes",1:"clinics")," are billable and may be auto billed on this date." G LSTQ
F IBK=1,2 S IBK1=$S(IBK=1:"NON-BILLABLE",1:"NOT AUTO BILLED") D
.W !!,?(80-$L(IBK1)\2),IBK1,!!
.I '$D(^TMP("IBEPTC2",$J,IBI,IBK)) W !,"No ",$S(IBI=352.3:"clinic stop codes",1:"clinics")," are flagged as ",IBK1,!
.S IBJ="" F S IBJ=$O(^TMP("IBEPTC2",$J,IBI,IBK,IBJ)) Q:IBJ="" D Q:IBQ
..S IBH=+^TMP("IBEPTC2",$J,IBI,IBK,IBJ)
..W:$X>40 ! I $Y>(IOSL-3) D PAUSE Q:IBQ D HDR
..W:$X>2 ?40 W $$VAL(IBI,IBH)
LSTQ Q
;
NBILL(IBF,IBEN,IBD) ; Is the entry not billable as of the effective date?
; Input: IBF -- Base file (#352.3, #352.4)
; IBEN -- Internal entry number for entry
; IBD -- Effective date for non-billing
N Y S Y=0
I '$G(IBF)!'$G(IBEN)!'$G(IBD) G NBILLQ
I $G(IBF)=352.3 S Y=+$$NBST^IBEFUNC(IBEN,IBDAT)_U_+$$NABST^IBEFUNC(IBEN,IBDAT) G NBILLQ
I $G(IBF)=352.4 S Y=+$$NBCT^IBEFUNC(IBEN,IBDAT)_U_+$$NABCT^IBEFUNC(IBEN,IBDAT)
NBILLQ Q Y
;
VAL(IBF,IBEN) ; Return the entry name.
; Input: IBF -- Base file (#352.3, #352.4)
; IBEN -- Internal entry number for entry
; Output: Entry name (#.01 from respective file)
N Y S Y="'ENTRY NAME UNKNOWN'"
I '$G(IBF)!'$G(IBEN) G VALQ
I $G(IBF)=352.3 S Y=$P($G(^DIC(40.7,IBEN,0)),"^") G VALQ
I $G(IBF)=352.4 S Y=$P($G(^SC(IBEN,0)),"^")
VALQ Q Y
;
DASH() ; Return a dashed line.
Q $TR($J("",80)," ","=")
;
PAUSE ; Page break
Q:$E(IOST,1,2)'="C-"
N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
F IBX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEPTC2 3518 printed Nov 22, 2024@17:32:21 Page 2
IBEPTC2 ;ALB/CPM/ARH - TP LIST NON-BILLABLE STOP CODES AND CLINICS ; 05-AUG-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; Option entry point - describe output.
+1 WRITE !!?5,"This report may be used to generate a list of all clinic stop codes,"
+2 WRITE !?5,"and clinics that are non-billable in Third Party Billing or "
+3 WRITE !,?5,"that will not have bills created by the Third Party Auto Biller.",!
+4 ;
+5 ; - grab effective date
+6 SET %DT="AEX"
SET %DT("A")="Please select the effective date for this list: "
SET %DT("B")=$$DAT2^IBOUTL(DT)
+7 DO ^%DT
KILL %DT
if Y<0
GOTO ENQ
SET IBDAT=Y
+8 ;
+9 ; - select a device
+10 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO ENQ
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 SET ZTRTN="DQ^IBEPTC2"
SET ZTDESC="LIST NON-BILLABLE STOPS/CLINICS"
SET ZTSAVE("IBDAT")=""
+13 DO ^%ZTLOAD
WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+14 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+15 ;
+16 USE IO
+17 ;
DQ ; Tasked entry point.
+1 ;
+2 ; - compile data
+3 DO ENQ1
FOR IBI=352.3,352.4
SET IBJ=0
FOR
SET IBJ=$ORDER(^IBE(IBI,"AIVDTT2",IBJ))
if 'IBJ
QUIT
Begin DoDot:1
+4 SET IBX=$$NBILL(IBI,IBJ,IBDAT)
+5 IF +IBX
SET ^TMP("IBEPTC2",$JOB,IBI,1,$$VAL(IBI,IBJ)_IBJ)=IBJ
QUIT
+6 IF +$PIECE(IBX,U,2)
SET ^TMP("IBEPTC2",$JOB,IBI,2,$EXTRACT($$VAL(IBI,IBJ),1,20)_IBJ)=IBJ
End DoDot:1
+7 ;
+8 ; - print results
+9 SET (IBPAG,IBQ)=0
FOR IBI=352.3,352.4
DO HDR
DO LST
if 'IBQ
DO PAUSE
if IBQ
QUIT
+10 ;
ENQ IF '$DATA(ZTQUEUED)
DO ^%ZISC
+1 KILL IBDAT,IBI,IBJ,IBQ,IBT,IBPAG
ENQ1 KILL ^TMP("IBEPTC2",$JOB)
+1 QUIT
+2 ;
HDR ; Generate a report header.
+1 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=IBPAG+1
SET IBT="LIST OF "_$SELECT(IBI=352.3:"CLINIC STOP CODES",1:"CLINICS")_" FLAGGED FOR THIRD PARTY BILLING"
+3 WRITE $$DASH(),!?(80-$LENGTH(IBT)\2),IBT,!?33,"As Of: ",$$DAT1^IBOUTL(IBDAT)
+4 WRITE !?64,"Page: ",IBPAG,!?60,"Run Date: ",$$DAT1^IBOUTL(DT)
+5 WRITE !,$$DASH(),!
+6 QUIT
+7 ;
LST ; List all selected entries.
+1 IF '$DATA(^TMP("IBEPTC2",$JOB,IBI))
WRITE "All ",$SELECT(IBI=352.3:"clinic stop codes",1:"clinics")," are billable and may be auto billed on this date."
GOTO LSTQ
+2 FOR IBK=1,2
SET IBK1=$SELECT(IBK=1:"NON-BILLABLE",1:"NOT AUTO BILLED")
Begin DoDot:1
+3 WRITE !!,?(80-$LENGTH(IBK1)\2),IBK1,!!
+4 IF '$DATA(^TMP("IBEPTC2",$JOB,IBI,IBK))
WRITE !,"No ",$SELECT(IBI=352.3:"clinic stop codes",1:"clinics")," are flagged as ",IBK1,!
+5 SET IBJ=""
FOR
SET IBJ=$ORDER(^TMP("IBEPTC2",$JOB,IBI,IBK,IBJ))
if IBJ=""
QUIT
Begin DoDot:2
+6 SET IBH=+^TMP("IBEPTC2",$JOB,IBI,IBK,IBJ)
+7 if $X>40
WRITE !
IF $Y>(IOSL-3)
DO PAUSE
if IBQ
QUIT
DO HDR
+8 if $X>2
WRITE ?40
WRITE $$VAL(IBI,IBH)
End DoDot:2
if IBQ
QUIT
End DoDot:1
LSTQ QUIT
+1 ;
NBILL(IBF,IBEN,IBD) ; Is the entry not billable as of the effective date?
+1 ; Input: IBF -- Base file (#352.3, #352.4)
+2 ; IBEN -- Internal entry number for entry
+3 ; IBD -- Effective date for non-billing
+4 NEW Y
SET Y=0
+5 IF '$GET(IBF)!'$GET(IBEN)!'$GET(IBD)
GOTO NBILLQ
+6 IF $GET(IBF)=352.3
SET Y=+$$NBST^IBEFUNC(IBEN,IBDAT)_U_+$$NABST^IBEFUNC(IBEN,IBDAT)
GOTO NBILLQ
+7 IF $GET(IBF)=352.4
SET Y=+$$NBCT^IBEFUNC(IBEN,IBDAT)_U_+$$NABCT^IBEFUNC(IBEN,IBDAT)
NBILLQ QUIT Y
+1 ;
VAL(IBF,IBEN) ; Return the entry name.
+1 ; Input: IBF -- Base file (#352.3, #352.4)
+2 ; IBEN -- Internal entry number for entry
+3 ; Output: Entry name (#.01 from respective file)
+4 NEW Y
SET Y="'ENTRY NAME UNKNOWN'"
+5 IF '$GET(IBF)!'$GET(IBEN)
GOTO VALQ
+6 IF $GET(IBF)=352.3
SET Y=$PIECE($GET(^DIC(40.7,IBEN,0)),"^")
GOTO VALQ
+7 IF $GET(IBF)=352.4
SET Y=$PIECE($GET(^SC(IBEN,0)),"^")
VALQ QUIT Y
+1 ;
DASH() ; Return a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",80)," ","=")
+2 ;
PAUSE ; Page break
+1 if $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 NEW IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
+3 FOR IBX=$Y:1:(IOSL-3)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+5 QUIT
