IBEPTC2.m

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 ---IBEPTC2   3518     printed  Mar 13, 2025@21:27:16                                                                                                                                                                                                     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