IBEPTC ;ALB/CPM/ARH - TP FLAG STOP CODES AND CLINICS ; 22-JUL-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 - main processing loop.
S IBQ=0 F D UPD Q:IBQ
K IBQ
Q
;
UPD ; Update the billable status for stop codes or clinics.
W @IOF,*13,?10,"Flag Stop Codes and Clinics for Third Party Billing"
W !,$$DASH(),!,"FOR THIRD PARTY BILLING, THIS OPTION IS USED TO SET UP:"
W !,"1. INDIVIDUAL OR A GROUP OF STOP CODES OR CLINICS AS:"
W !," a. NON-BILLABLE OR BILLABLE."
W !," A Stop/Clinic is assumed billable until it is flagged as non-billable."
W !," b. IGNORED BY THE AUTO BILLER. Stops the auto biller from creating"
W !," bills for specified billable Stops/Clinics."
W !,"2. ALL CLINICS TO BE:"
W !," a. IGNORED BY THE AUTO BILLER. Stops the auto biller from creating bills"
W !," for ALL clinics. Should only be used if the outpatient auto biller"
W !," is on but only a small number of Clinics should be auto billed."
W !," b. BILLED BY THE AUTO BILLER. Resets all Clinics to be auto billed."
W !,"Use of this option will have an immediate effect on your billing operations"
W !,"so you should have your work pre-planned before using this option.",!,$$DASH()
;
; - select stop codes or clinics.
S DIR(0)="SO^S:STOP CODES;C:CLINICS;A:ALL CLINICS",DIR("?")="^D HSEL^IBEPTC1"
S DIR("A")="Enter your choice" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) G UPDQ
I Y="A" G ^IBEPTC3
S IBINFO=$T(@Y+1)
;
; - some help
W !!,$$DASH(),!,"You may now enter the ",$P(IBINFO,";",3)," that you wish to flag. Please note"
W !,"all ",$P(IBINFO,";",3)," that you select will be assigned the same effective"
W !,"date and billable status and auto bill status.",!,$$DASH(),!
;
; - select all entries to be updated
S (IBNUM,IBHIT)=0 D UPDQ1 F D Q:Y<0
.S DIC=$P(IBINFO,";",5),DIC(0)="QEAMZ"
.S DIC("A")=$S(IBHIT:"Next",1:"Select")_" "_$P(IBINFO,";",4)_": "
.S:$P(IBINFO,";",6)]"" DIC("S")=$P(IBINFO,";",6)
.D ^DIC K DIC Q:Y<0 S IBHIT=1
.I $D(^TMP("IBEPTC",$J,+Y)) W !,"Please note that you've already selected ",Y(0,0),"."
.E S ^TMP("IBEPTC",$J,+Y)=Y(0,0),IBNUM=IBNUM+1
;
; - quit if no selections were made.
I '$D(^TMP("IBEPTC",$J)) W !!,"No ",$P(IBINFO,";",3)," selected!" S IBQ=1 G UPDQ
;
; - allow review of the selections.
I IBNUM>1 D REV^IBEPTC1 I IBQ G UPDQ
;
; - quit if all entries were de-selected (but allow re-start).
I '$D(^TMP("IBEPTC",$J)) W !!,"All ",$P(IBINFO,";",3)," were de-selected!" G UPDQ
;
; - should be Third Party Billable or Non-billable?
S DIR(0)="Y",DIR("A")=$S(IBNUM=1:"Is this",1:"Are these")_" "_$P(IBINFO,";",$S(IBNUM=1:7,1:3))_" Non-Billable for Third Party Billing"
S DIR("?")="^D HACT^IBEPTC1"
W ! D ^DIR K DIR G:($D(DIRUT))!($D(DUOUT)) UPDQ
S IBFILE=+Y,IBACT=$S(IBFILE:"Non-",1:"")
;
I +IBFILE S IBTPAB="",IBACT1="NOT "
I 'IBFILE D I IBTPAB<0 G UPDQ
. S DIR(0)="Y",DIR("A")="Should the Third Party Auto Biller create bills for "_$S(IBNUM=1:"this",1:"these")_" "_$P(IBINFO,";",$S(IBNUM=1:7,1:3))
. S DIR("?")="^D HAUTO^IBEPTC1"
. W ! D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBTPAB=-1 Q
. S IBTPAB=$S(+Y:0,1:1),IBACT1=$S(IBTPAB:"NOT ",1:"")
;
; - what is the effective date for this action?
S %DT="AEX",%DT("A")="Please enter the date this should become effective: "
D ^%DT K %DT G:Y<0 UPDQ S IBDAT=Y
I Y>DT W !!,"Please note that you've selected a future date!"
;
; - re-display the list of selected entries.
W !!,$$DASH() D LIST^IBEPTC1
W !!,"Effective ",$$FMTE^XLFDT(IBDAT)," the above ",$P(IBINFO,";",3)," will be ",IBACT,"billable"
W !,"and will ",IBACT1,"have bills created by the Third Party auto biller.",!
;
; - okay to proceed and file entries?
S DIR(0)="Y",DIR("A")="Is this correct, is it okay to proceed and file these entries"
S DIR("?")="Enter 'Y' to file these entries, 'N' to try again, or '^' to quit."
D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G UPDQ
;
; - file selected entries.
W !!,"Filing these ",$P(IBINFO,";",4)," entries... " D FILE^IBEPTC1
W ! S DIR(0)="E" D ^DIR K DIR,DIRUT,DUOUT
;
UPDQ S:$D(DIRUT)!($D(DUOUT)) IBQ=1
K DIRUT,DUOUT,DTOUT,DIROUT,IBINFO,IBNUM,IBFILE,IBACT,IBDAT,IBHIT,IBACT1,IBTPAB
UPDQ1 K ^TMP("IBEPTC",$J)
Q
;
DASH() ; Write a dashed line.
Q $TR($J("",79)," ","=")
;
INFO ; Description of stop/clinic information listed below.
;;desc (plural);desc (selection);source file root;source screen;desc (sing);dest file root;dest file #
;
S ; Stop Code Information
;;clinic stop codes;CLINIC STOP CODE;^DIC(40.7,;I '$P(^(0),U,3);clinic stop code;^IBE(352.3,;352.3
;
C ; Clinic Information
;;clinics;CLINIC;^SC(;I $P(^(0),U,3)="C";clinic;^IBE(352.4,;352.4
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEPTC 4844 printed Apr 09, 2024@21:23:03 Page 2
IBEPTC ;ALB/CPM/ARH - TP FLAG STOP CODES AND CLINICS ; 22-JUL-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 - main processing loop.
+1 SET IBQ=0
FOR
DO UPD
if IBQ
QUIT
+2 KILL IBQ
+3 QUIT
+4 ;
UPD ; Update the billable status for stop codes or clinics.
+1 WRITE @IOF,*13,?10,"Flag Stop Codes and Clinics for Third Party Billing"
+2 WRITE !,$$DASH(),!,"FOR THIRD PARTY BILLING, THIS OPTION IS USED TO SET UP:"
+3 WRITE !,"1. INDIVIDUAL OR A GROUP OF STOP CODES OR CLINICS AS:"
+4 WRITE !," a. NON-BILLABLE OR BILLABLE."
+5 WRITE !," A Stop/Clinic is assumed billable until it is flagged as non-billable."
+6 WRITE !," b. IGNORED BY THE AUTO BILLER. Stops the auto biller from creating"
+7 WRITE !," bills for specified billable Stops/Clinics."
+8 WRITE !,"2. ALL CLINICS TO BE:"
+9 WRITE !," a. IGNORED BY THE AUTO BILLER. Stops the auto biller from creating bills"
+10 WRITE !," for ALL clinics. Should only be used if the outpatient auto biller"
+11 WRITE !," is on but only a small number of Clinics should be auto billed."
+12 WRITE !," b. BILLED BY THE AUTO BILLER. Resets all Clinics to be auto billed."
+13 WRITE !,"Use of this option will have an immediate effect on your billing operations"
+14 WRITE !,"so you should have your work pre-planned before using this option.",!,$$DASH()
+15 ;
+16 ; - select stop codes or clinics.
+17 SET DIR(0)="SO^S:STOP CODES;C:CLINICS;A:ALL CLINICS"
SET DIR("?")="^D HSEL^IBEPTC1"
+18 SET DIR("A")="Enter your choice"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
GOTO UPDQ
+19 IF Y="A"
GOTO ^IBEPTC3
+20 SET IBINFO=$TEXT(@Y+1)
+21 ;
+22 ; - some help
+23 WRITE !!,$$DASH(),!,"You may now enter the ",$PIECE(IBINFO,";",3)," that you wish to flag. Please note"
+24 WRITE !,"all ",$PIECE(IBINFO,";",3)," that you select will be assigned the same effective"
+25 WRITE !,"date and billable status and auto bill status.",!,$$DASH(),!
+26 ;
+27 ; - select all entries to be updated
+28 SET (IBNUM,IBHIT)=0
DO UPDQ1
FOR
Begin DoDot:1
+29 SET DIC=$PIECE(IBINFO,";",5)
SET DIC(0)="QEAMZ"
+30 SET DIC("A")=$SELECT(IBHIT:"Next",1:"Select")_" "_$PIECE(IBINFO,";",4)_": "
+31 if $PIECE(IBINFO,";",6)]""
SET DIC("S")=$PIECE(IBINFO,";",6)
+32 DO ^DIC
KILL DIC
if Y<0
QUIT
SET IBHIT=1
+33 IF $DATA(^TMP("IBEPTC",$JOB,+Y))
WRITE !,"Please note that you've already selected ",Y(0,0),"."
+34 IF '$TEST
SET ^TMP("IBEPTC",$JOB,+Y)=Y(0,0)
SET IBNUM=IBNUM+1
End DoDot:1
if Y<0
QUIT
+35 ;
+36 ; - quit if no selections were made.
+37 IF '$DATA(^TMP("IBEPTC",$JOB))
WRITE !!,"No ",$PIECE(IBINFO,";",3)," selected!"
SET IBQ=1
GOTO UPDQ
+38 ;
+39 ; - allow review of the selections.
+40 IF IBNUM>1
DO REV^IBEPTC1
IF IBQ
GOTO UPDQ
+41 ;
+42 ; - quit if all entries were de-selected (but allow re-start).
+43 IF '$DATA(^TMP("IBEPTC",$JOB))
WRITE !!,"All ",$PIECE(IBINFO,";",3)," were de-selected!"
GOTO UPDQ
+44 ;
+45 ; - should be Third Party Billable or Non-billable?
+46 SET DIR(0)="Y"
SET DIR("A")=$SELECT(IBNUM=1:"Is this",1:"Are these")_" "_$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))_" Non-Billable for Third Party Billing"
+47 SET DIR("?")="^D HACT^IBEPTC1"
+48 WRITE !
DO ^DIR
KILL DIR
if ($DATA(DIRUT))!($DATA(DUOUT))
GOTO UPDQ
+49 SET IBFILE=+Y
SET IBACT=$SELECT(IBFILE:"Non-",1:"")
+50 ;
+51 IF +IBFILE
SET IBTPAB=""
SET IBACT1="NOT "
+52 IF 'IBFILE
Begin DoDot:1
+53 SET DIR(0)="Y"
SET DIR("A")="Should the Third Party Auto Biller create bills for "_$SELECT(IBNUM=1:"this",1:"these")_" "_$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))
+54 SET DIR("?")="^D HAUTO^IBEPTC1"
+55 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBTPAB=-1
QUIT
+56 SET IBTPAB=$SELECT(+Y:0,1:1)
SET IBACT1=$SELECT(IBTPAB:"NOT ",1:"")
End DoDot:1
IF IBTPAB<0
GOTO UPDQ
+57 ;
+58 ; - what is the effective date for this action?
+59 SET %DT="AEX"
SET %DT("A")="Please enter the date this should become effective: "
+60 DO ^%DT
KILL %DT
if Y<0
GOTO UPDQ
SET IBDAT=Y
+61 IF Y>DT
WRITE !!,"Please note that you've selected a future date!"
+62 ;
+63 ; - re-display the list of selected entries.
+64 WRITE !!,$$DASH()
DO LIST^IBEPTC1
+65 WRITE !!,"Effective ",$$FMTE^XLFDT(IBDAT)," the above ",$PIECE(IBINFO,";",3)," will be ",IBACT,"billable"
+66 WRITE !,"and will ",IBACT1,"have bills created by the Third Party auto biller.",!
+67 ;
+68 ; - okay to proceed and file entries?
+69 SET DIR(0)="Y"
SET DIR("A")="Is this correct, is it okay to proceed and file these entries"
+70 SET DIR("?")="Enter 'Y' to file these entries, 'N' to try again, or '^' to quit."
+71 DO ^DIR
KILL DIR
IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
GOTO UPDQ
+72 ;
+73 ; - file selected entries.
+74 WRITE !!,"Filing these ",$PIECE(IBINFO,";",4)," entries... "
DO FILE^IBEPTC1
+75 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR,DIRUT,DUOUT
+76 ;
UPDQ if $DATA(DIRUT)!($DATA(DUOUT))
SET IBQ=1
+1 KILL DIRUT,DUOUT,DTOUT,DIROUT,IBINFO,IBNUM,IBFILE,IBACT,IBDAT,IBHIT,IBACT1,IBTPAB
UPDQ1 KILL ^TMP("IBEPTC",$JOB)
+1 QUIT
+2 ;
DASH() ; Write a dashed line.
+1 QUIT $TRANSLATE($JUSTIFY("",79)," ","=")
+2 ;
INFO ; Description of stop/clinic information listed below.
+1 ;;desc (plural);desc (selection);source file root;source screen;desc (sing);dest file root;dest file #
+2 ;
S ; Stop Code Information
+1 ;;clinic stop codes;CLINIC STOP CODE;^DIC(40.7,;I '$P(^(0),U,3);clinic stop code;^IBE(352.3,;352.3
+2 ;
C ; Clinic Information
+1 ;;clinics;CLINIC;^SC(;I $P(^(0),U,3)="C";clinic;^IBE(352.4,;352.4
+2 ;
+3 QUIT
