IBTRE2 ;ALB/AAS - CLAIMS TRACKING - ACTIONS ; 27-JUN-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
% G EN^IBTRE
;
AT ; -- Add tracking entry
D FULL^VALM1
N X,Y,DIC,DA,DR,DD,DO,DIR,DIRUT,DTOUT,DUOUT,IBETYP,IBQUIT,IBTDT,VAIN,VAINDT,IBTRN,IBTDTE
;
TEST S IBQUIT=0
S DIC(0)="AEQMNZ",DIC="^IBE(356.6,",DIC("S")="I $P(^(0),U,3)<3",DIC("A")="Select Tracking Type: "
D ^DIC K DIC S IBETYP=+Y I +Y<0 G ATQ
W !
;
ADM I IBETYP=$O(^IBE(356.6,"AC",1,0)) D I IBQUIT G ATQ
.N DIR
.S DIR("?")=" "
.S DIR("?",1)=" Enter any Date!"
.S DIR("?",2)=" "
.S DIR("?",3)=" If the patient was an inpatient on that date the system will use the"
.S DIR("?",4)=" correct admission date. If you are tracking an admissions at another"
.S DIR("?",5)=" facility you may enter that date. Enter '??' to get a list of the"
.S DIR("?",6)=" last 10 admissions for this patient."
.S DIR("??")="^D LISTA^IBTRE20"
.S DIR(0)="DO^::AEXTP",DIR("A")="Admission Date"
.D ^DIR K DIR S (IBTDT,VAINDT)=+Y I $P(VAINDT,".",2)="" S VAINDT=VAINDT+.24
.I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
.; -- check for valid admission
.S VA200="" D INP^VADPT
.I VAIN(1)="" D
..W !!,*7,"WARNING: Patient does not appear to be an inpatient on this date!"
..I VAIN(7)="" S VAIN(7)=IBTDT,Y=IBTDT D D^DIQ S $P(VAIN(7),"^",2)=Y
.;
.S DIR("?")="No admission was found for this date, enter 'Yes' if you want to add this anyway, or 'No' if you do not wish to track this date."
.S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Admission Date "_$P(VAIN(7),"^",2),DIR("B")="NO"
.D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
.I VAIN(1) D ADM^IBTUTL(VAIN(1))
.I 'VAIN(1) D OTH^IBTUTL(DFN,IBETYP,IBTDT)
.Q
;
OPT I IBETYP=$O(^IBE(356.6,"AC",2,0)) D I IBQUIT G ATQ
.;
.N DIR
.S DIR("?")="Time is Required."
.S DIR("?",1)=" Enter the Outpatient Visit Date."
.S DIR("?",2)=" If no scheduled visit is found you will be given a warning. Enter"
.S DIR("?",3)=" '??' to get a list of scheduled visits between "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_"."
.I '$D(IBTASS) S DIR("?",4)=" Use the change date range action to change listing of scheduled Visits."
.S DIR("??")="^D LISTO^IBTRE20"
.S DIR(0)="DO^::AEXTP",DIR("A")="Outpatient Visit Date"
.D ^DIR K DIR S IBTDT=Y
.I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
.;
.; check "s" node and encounters file for entries
.S X=$D(^DPT(DFN,"S",IBTDT))
.I 'X S Y=$O(^DPT(DFN,"S",$P(IBTDT,"."))) I $P(IBTDT,".")=$P(Y,".") S IBTDT=Y,X=1
.
.; if non say so
.I 'X W !!,*7,"WARNING: No Visit information for this Patient for this date.",!
.;
.; ask if okay to add entry.
.S Y=IBTDT D D^DIQ S IBTDTE=Y
.S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Visit Date "_IBTDTE,DIR("B")="NO"
.D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
.D OPT^IBTUTL1(DFN,IBETYP,IBTDT)
.Q
;
SCH I IBETYP=$O(^IBE(356.6,"AC",5,0)) D I IBQUIT G ATQ
.N DIR
.S DIR("?")=" "
.S DIR("?",1)=" Enter date of the scheduled admission."
.S DIR("?",2)=" If you use the scheduled admission package to schedule admissions"
.S DIR("?",3)=" you may enter '??' to get a list of scheduled admissions between"
.S DIR("?",4)=" "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_". Use the change date range action"
.S DIR("?",5)=" to change listing of scheduled admissions."
.S DIR("?",5)=" This should be a future scheduled admission."
.S DIR(0)="DO^::AEXTP",DIR("A")="Scheduled Admission Date"
.S DIR("??")="^D LISTS^IBTRE20"
.D ^DIR K DIR S IBTDT=+Y
.I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
.; ask if okay to add entry.
.D FINDS^IBTRE20
.S Y=IBTDT D D^DIQ S IBTDTE=Y
.S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Scheduled Adm. Date "_IBTDTE,DIR("B")="NO"
.D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
.I IBTDT\1'>DT S VAINDT=IBTDT\1+.24 D INP^VADPT I $G(VAIN(1)) D Q
..W !!,"Patient an inpatient on this date, using inpatient admission."
..D ADM^IBTUTL(VAIN(1))
.D SCH^IBTUTL2(DFN,IBTDT)
.Q
I $G(IBQUIT) G ATQ
I $D(IBTASS) Q ; leave prematurely if from assign reason
;
I $G(IBTRN) N IBTATRK S IBTATRK=1 D QE1^IBTRE1
;
D BLD^IBTRE
ATQ Q:$D(IBTASS)
I $G(IBQUIT) W !,"Nothing Added",! D PAUSE^VALM1
S VALMBCK="R"
Q
IBTRE2 ;ALB/AAS - CLAIMS TRACKING - ACTIONS ; 27-JUN-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
% GOTO EN^IBTRE
+1 ;
AT ; -- Add tracking entry
+1 DO FULL^VALM1
+2 NEW X,Y,DIC,DA,DR,DD,DO,DIR,DIRUT,DTOUT,DUOUT,IBETYP,IBQUIT,IBTDT,VAIN,VAINDT,IBTRN,IBTDTE
+3 ;
TEST SET IBQUIT=0
+1 SET DIC(0)="AEQMNZ"
SET DIC="^IBE(356.6,"
SET DIC("S")="I $P(^(0),U,3)<3"
SET DIC("A")="Select Tracking Type: "
+2 DO ^DIC
KILL DIC
SET IBETYP=+Y
IF +Y<0
GOTO ATQ
+3 WRITE !
+4 ;
ADM IF IBETYP=$ORDER(^IBE(356.6,"AC",1,0))
Begin DoDot:1
+1 NEW DIR
+2 SET DIR("?")=" "
+3 SET DIR("?",1)=" Enter any Date!"
+4 SET DIR("?",2)=" "
+5 SET DIR("?",3)=" If the patient was an inpatient on that date the system will use the"
+6 SET DIR("?",4)=" correct admission date. If you are tracking an admissions at another"
+7 SET DIR("?",5)=" facility you may enter that date. Enter '??' to get a list of the"
+8 SET DIR("?",6)=" last 10 admissions for this patient."
+9 SET DIR("??")="^D LISTA^IBTRE20"
+10 SET DIR(0)="DO^::AEXTP"
SET DIR("A")="Admission Date"
+11 DO ^DIR
KILL DIR
SET (IBTDT,VAINDT)=+Y
IF $PIECE(VAINDT,".",2)=""
SET VAINDT=VAINDT+.24
+12 IF $DATA(DIRUT)!($PIECE(IBTDT,".")'?7N)
SET IBQUIT=1
QUIT
+13 ; -- check for valid admission
+14 SET VA200=""
DO INP^VADPT
+15 IF VAIN(1)=""
Begin DoDot:2
+16 WRITE !!,*7,"WARNING: Patient does not appear to be an inpatient on this date!"
+17 IF VAIN(7)=""
SET VAIN(7)=IBTDT
SET Y=IBTDT
DO D^DIQ
SET $PIECE(VAIN(7),"^",2)=Y
End DoDot:2
+18 ;
+19 SET DIR("?")="No admission was found for this date, enter 'Yes' if you want to add this anyway, or 'No' if you do not wish to track this date."
+20 SET DIR(0)="Y"
SET DIR("A")="Okay to Add Claims Tracking entry for Admission Date "_$PIECE(VAIN(7),"^",2)
SET DIR("B")="NO"
+21 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!('Y)
SET IBQUIT=1
QUIT
+22 IF VAIN(1)
DO ADM^IBTUTL(VAIN(1))
+23 IF 'VAIN(1)
DO OTH^IBTUTL(DFN,IBETYP,IBTDT)
+24 QUIT
End DoDot:1
IF IBQUIT
GOTO ATQ
+25 ;
OPT IF IBETYP=$ORDER(^IBE(356.6,"AC",2,0))
Begin DoDot:1
+1 ;
+2 NEW DIR
+3 SET DIR("?")="Time is Required."
+4 SET DIR("?",1)=" Enter the Outpatient Visit Date."
+5 SET DIR("?",2)=" If no scheduled visit is found you will be given a warning. Enter"
+6 SET DIR("?",3)=" '??' to get a list of scheduled visits between "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_"."
+7 IF '$DATA(IBTASS)
SET DIR("?",4)=" Use the change date range action to change listing of scheduled Visits."
+8 SET DIR("??")="^D LISTO^IBTRE20"
+9 SET DIR(0)="DO^::AEXTP"
SET DIR("A")="Outpatient Visit Date"
+10 DO ^DIR
KILL DIR
SET IBTDT=Y
+11 IF $DATA(DIRUT)!($PIECE(IBTDT,".")'?7N)
SET IBQUIT=1
QUIT
+12 ;
+13 ; check "s" node and encounters file for entries
+14 SET X=$DATA(^DPT(DFN,"S",IBTDT))
+15 IF 'X
SET Y=$ORDER(^DPT(DFN,"S",$PIECE(IBTDT,".")))
IF $PIECE(IBTDT,".")=$PIECE(Y,".")
SET IBTDT=Y
SET X=1
+16 +17 ; if non say so
+18 IF 'X
WRITE !!,*7,"WARNING: No Visit information for this Patient for this date.",!
+19 ;
+20 ; ask if okay to add entry.
+21 SET Y=IBTDT
DO D^DIQ
SET IBTDTE=Y
+22 SET DIR(0)="Y"
SET DIR("A")="Okay to Add Claims Tracking entry for Visit Date "_IBTDTE
SET DIR("B")="NO"
+23 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!('Y)
SET IBQUIT=1
QUIT
+24 DO OPT^IBTUTL1(DFN,IBETYP,IBTDT)
+25 QUIT
End DoDot:1
IF IBQUIT
GOTO ATQ
+26 ;
SCH IF IBETYP=$ORDER(^IBE(356.6,"AC",5,0))
Begin DoDot:1
+1 NEW DIR
+2 SET DIR("?")=" "
+3 SET DIR("?",1)=" Enter date of the scheduled admission."
+4 SET DIR("?",2)=" If you use the scheduled admission package to schedule admissions"
+5 SET DIR("?",3)=" you may enter '??' to get a list of scheduled admissions between"
+6 SET DIR("?",4)=" "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_". Use the change date range action"
+7 SET DIR("?",5)=" to change listing of scheduled admissions."
+8 SET DIR("?",5)=" This should be a future scheduled admission."
+9 SET DIR(0)="DO^::AEXTP"
SET DIR("A")="Scheduled Admission Date"
+10 SET DIR("??")="^D LISTS^IBTRE20"
+11 DO ^DIR
KILL DIR
SET IBTDT=+Y
+12 IF $DATA(DIRUT)!($PIECE(IBTDT,".")'?7N)
SET IBQUIT=1
QUIT
+13 ; ask if okay to add entry.
+14 DO FINDS^IBTRE20
+15 SET Y=IBTDT
DO D^DIQ
SET IBTDTE=Y
+16 SET DIR(0)="Y"
SET DIR("A")="Okay to Add Claims Tracking entry for Scheduled Adm. Date "_IBTDTE
SET DIR("B")="NO"
+17 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!('Y)
SET IBQUIT=1
QUIT
+18 IF IBTDT\1'>DT
SET VAINDT=IBTDT\1+.24
DO INP^VADPT
IF $GET(VAIN(1))
Begin DoDot:2
+19 WRITE !!,"Patient an inpatient on this date, using inpatient admission."
+20 DO ADM^IBTUTL(VAIN(1))
End DoDot:2
QUIT
+21 DO SCH^IBTUTL2(DFN,IBTDT)
+22 QUIT
End DoDot:1
IF IBQUIT
GOTO ATQ
+23 IF $GET(IBQUIT)
GOTO ATQ
+24 ; leave prematurely if from assign reason
IF $DATA(IBTASS)
QUIT
+25 ;
+26 IF $GET(IBTRN)
NEW IBTATRK
SET IBTATRK=1
DO QE1^IBTRE1
+27 ;
+28 DO BLD^IBTRE
ATQ IF $DATA(IBTASS)
QUIT
+1 IF $GET(IBQUIT)
WRITE !,"Nothing Added",!
DO PAUSE^VALM1
+2 SET VALMBCK="R"
+3 QUIT
