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

IBTRE2.m

Go to the documentation of this file.
  1. IBTRE2 ;ALB/AAS - CLAIMS TRACKING - ACTIONS ; 27-JUN-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. % G EN^IBTRE
  1. ;
  1. AT ; -- Add tracking entry
  1. D FULL^VALM1
  1. N X,Y,DIC,DA,DR,DD,DO,DIR,DIRUT,DTOUT,DUOUT,IBETYP,IBQUIT,IBTDT,VAIN,VAINDT,IBTRN,IBTDTE
  1. ;
  1. TEST S IBQUIT=0
  1. S DIC(0)="AEQMNZ",DIC="^IBE(356.6,",DIC("S")="I $P(^(0),U,3)<3",DIC("A")="Select Tracking Type: "
  1. D ^DIC K DIC S IBETYP=+Y I +Y<0 G ATQ
  1. W !
  1. ;
  1. ADM I IBETYP=$O(^IBE(356.6,"AC",1,0)) D I IBQUIT G ATQ
  1. .N DIR
  1. .S DIR("?")=" "
  1. .S DIR("?",1)=" Enter any Date!"
  1. .S DIR("?",2)=" "
  1. .S DIR("?",3)=" If the patient was an inpatient on that date the system will use the"
  1. .S DIR("?",4)=" correct admission date. If you are tracking an admissions at another"
  1. .S DIR("?",5)=" facility you may enter that date. Enter '??' to get a list of the"
  1. .S DIR("?",6)=" last 10 admissions for this patient."
  1. .S DIR("??")="^D LISTA^IBTRE20"
  1. .S DIR(0)="DO^::AEXTP",DIR("A")="Admission Date"
  1. .D ^DIR K DIR S (IBTDT,VAINDT)=+Y I $P(VAINDT,".",2)="" S VAINDT=VAINDT+.24
  1. .I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
  1. .; -- check for valid admission
  1. .S VA200="" D INP^VADPT
  1. .I VAIN(1)="" D
  1. ..W !!,*7,"WARNING: Patient does not appear to be an inpatient on this date!"
  1. ..I VAIN(7)="" S VAIN(7)=IBTDT,Y=IBTDT D D^DIQ S $P(VAIN(7),"^",2)=Y
  1. .;
  1. .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."
  1. .S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Admission Date "_$P(VAIN(7),"^",2),DIR("B")="NO"
  1. .D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
  1. .I VAIN(1) D ADM^IBTUTL(VAIN(1))
  1. .I 'VAIN(1) D OTH^IBTUTL(DFN,IBETYP,IBTDT)
  1. .Q
  1. ;
  1. OPT I IBETYP=$O(^IBE(356.6,"AC",2,0)) D I IBQUIT G ATQ
  1. .;
  1. .N DIR
  1. .S DIR("?")="Time is Required."
  1. .S DIR("?",1)=" Enter the Outpatient Visit Date."
  1. .S DIR("?",2)=" If no scheduled visit is found you will be given a warning. Enter"
  1. .S DIR("?",3)=" '??' to get a list of scheduled visits between "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_"."
  1. .I '$D(IBTASS) S DIR("?",4)=" Use the change date range action to change listing of scheduled Visits."
  1. .S DIR("??")="^D LISTO^IBTRE20"
  1. .S DIR(0)="DO^::AEXTP",DIR("A")="Outpatient Visit Date"
  1. .D ^DIR K DIR S IBTDT=Y
  1. .I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
  1. .;
  1. .; check "s" node and encounters file for entries
  1. .S X=$D(^DPT(DFN,"S",IBTDT))
  1. .I 'X S Y=$O(^DPT(DFN,"S",$P(IBTDT,"."))) I $P(IBTDT,".")=$P(Y,".") S IBTDT=Y,X=1
  1. .
  1. .; if non say so
  1. .I 'X W !!,*7,"WARNING: No Visit information for this Patient for this date.",!
  1. .;
  1. .; ask if okay to add entry.
  1. .S Y=IBTDT D D^DIQ S IBTDTE=Y
  1. .S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Visit Date "_IBTDTE,DIR("B")="NO"
  1. .D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
  1. .D OPT^IBTUTL1(DFN,IBETYP,IBTDT)
  1. .Q
  1. ;
  1. SCH I IBETYP=$O(^IBE(356.6,"AC",5,0)) D I IBQUIT G ATQ
  1. .N DIR
  1. .S DIR("?")=" "
  1. .S DIR("?",1)=" Enter date of the scheduled admission."
  1. .S DIR("?",2)=" If you use the scheduled admission package to schedule admissions"
  1. .S DIR("?",3)=" you may enter '??' to get a list of scheduled admissions between"
  1. .S DIR("?",4)=" "_$$DAT1^IBOUTL(IBTBDT)_" and "_$$DAT1^IBOUTL(IBTEDT)_". Use the change date range action"
  1. .S DIR("?",5)=" to change listing of scheduled admissions."
  1. .S DIR("?",5)=" This should be a future scheduled admission."
  1. .S DIR(0)="DO^::AEXTP",DIR("A")="Scheduled Admission Date"
  1. .S DIR("??")="^D LISTS^IBTRE20"
  1. .D ^DIR K DIR S IBTDT=+Y
  1. .I $D(DIRUT)!($P(IBTDT,".")'?7N) S IBQUIT=1 Q
  1. .; ask if okay to add entry.
  1. .D FINDS^IBTRE20
  1. .S Y=IBTDT D D^DIQ S IBTDTE=Y
  1. .S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Scheduled Adm. Date "_IBTDTE,DIR("B")="NO"
  1. .D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
  1. .I IBTDT\1'>DT S VAINDT=IBTDT\1+.24 D INP^VADPT I $G(VAIN(1)) D Q
  1. ..W !!,"Patient an inpatient on this date, using inpatient admission."
  1. ..D ADM^IBTUTL(VAIN(1))
  1. .D SCH^IBTUTL2(DFN,IBTDT)
  1. .Q
  1. I $G(IBQUIT) G ATQ
  1. I $D(IBTASS) Q ; leave prematurely if from assign reason
  1. ;
  1. I $G(IBTRN) N IBTATRK S IBTATRK=1 D QE1^IBTRE1
  1. ;
  1. D BLD^IBTRE
  1. ATQ Q:$D(IBTASS)
  1. I $G(IBQUIT) W !,"Nothing Added",! D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q