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.  ;;2.0;INTEGRATED BILLING;**23,121,249,312,568**;21-MAR-94;Build 40
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. % G EN^IBTRE
  1.  ;
  1. AT ; -- Add tracking entry
  1.  I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q                   ;IB*2.0*312
  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.  N IBDEL,IBDELO,IBMARK,IBPR,IBPRO,PCOV,PIEN,RC
  1.  ;
  1. TEST S IBQUIT=0
  1.  S DIC(0)="AEQMNZ",DIC="^IBE(356.6,",DIC("S")="I $P(^(0),U,3)<3!($P(^(0),U,3)=4)",DIC("A")="Select Tracking Type: "  ;568
  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 I VAIN(1)="" D  ;look for one day admission
  1.  ..S IBX=+$O(^(+$O(^DGPM("ATID1",DFN,9999999-IBTDT)),0)),IBX=+$G(^DGPM(IBX,0))
  1.  ..I $E(IBX,1,7)=IBTDT S VAINDT=IBX D INP^VADPT ;9999999.9999999
  1.  ..I VAIN(1) W !!,"WARNING: This appears to be a one day stay."
  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,IBSD,IBARRAY
  1.  .;get all possible scheduling data for patient
  1.  .K ^TMP($J,"SDAMA301")
  1.  .S IBARRAY(4)=DFN,IBARRAY("SORT")="P",IBARRAY("FLDS")="1;2;3;10;12",IBSD=$$SDAPI^SDAMA301(.IBARRAY)
  1.  .;
  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 scheduling and encounters file for entries
  1.  .S X=$D(^TMP($J,"SDAMA301",DFN,IBTDT))
  1.  .;
  1.  .I 'X,IBSD<0 W !!,*7,"WARNING: Unable to look up Visit information for this Patient" X "N IBX S IBX=0 F  S IBX=$O(^TMP($J,""SDAMA301"",IBX)) W !?5,IBX,?10,$G(^(IBX))"
  1.  .;
  1.  .I 'X,IBSD S Y=$O(^TMP($J,"SDAMA301",DFN,$P(IBTDT,"."))) I $P(IBTDT,".")=$P(Y,".") S IBTDT=Y,X=1
  1.  .;
  1.  .; if non say so
  1.  .I 'X,IBSD'=-1 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,$P($G(^TMP($J,"SDAMA301",DFN,IBTDT)),"^",12))
  1.  .K ^TMP($J,"SDAMA301")
  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^::AEXT",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.  ;
  1. PRO I IBETYP=$O(^IBE(356.6,"AC",3,0)) D  I IBQUIT G ATQ
  1.  .;
  1.  .N DIR,IBSD,IBARRAY,C,IBDEL,IBDELO,IBMARK
  1.  .;get all possible scheduling data for patient
  1.  .S IBARRAY(0)=DFN
  1.  .;
  1.  .D LISTP^IBTRE20
  1.  .W !
  1.  .I C=0 S IBQUIT=1 Q
  1.  .S DIR("?")="Prosthetics"
  1.  .S DIR(0)="N",DIR("A")="Prosthetics Entry"
  1.  .D ^DIR K DIR
  1.  .I $D(DIRUT) S IBQUIT=1 Q
  1.  .I Y>0 S RC=IBARRAY(Y),IBDEL=$P(RC,U,3),IBPRO=$P(RC,U,4),PIEN=$P(RC,U,1),IBPR=$P(RC,U,2),IBDELO=$P(RC,U,5)
  1.  .;
  1.  .; ask if okay to add entry.
  1.  .S Y=IBDEL D D^DIQ S IBTDTE=Y
  1.  .S DIR(0)="Y",DIR("A")="Okay to Add Claims Tracking entry for Prosthetics "_IBPRO_" for "_IBDELO,DIR("B")="NO"
  1.  .D ^DIR K DIR I $D(DIRUT)!('Y) S IBQUIT=1 Q
  1.  .S PCOV=$$PTCOV^IBCNSU3(DFN,IBDEL,"PROSTHETICS")
  1.  .S IBMARK="" I 'PCOV S IBMARK="NO PROSTHETIC COVERAGE"
  1.  .D PRO^IBTUTL1(DFN,IBDEL,PIEN,IBMARK)
  1.  .Q
  1.  ;
  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.  ;
  1. ATQ Q:$D(IBTASS)
  1.  I $G(IBQUIT) W !,"Nothing Added",! D PAUSE^VALM1
  1.  S VALMBCK="R"
  1.  Q