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

IBJDF8I1.m

Go to the documentation of this file. 
  1. IBJDF8I1 ;ALB/RRG-ADD/EDIT IB DM WORKLOAD PARAMETERS-(CONT.) ;11/06/00
  1.  ;;2.0;INTEGRATED BILLING;**123**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. EDIT ; - Edit existing assignments
  1.  ;
  1.  N IBASDA0,IBASNNUM W !
  1.  S DIR("A")="Choose a valid Assignment Number to edit: "
  1.  S DIR(0)="LA^1:"_(IBNEWASN-1)_"^K:'$D(IBAS(X)) X"
  1.  S DIR("?")="Must be a valid assignment listed above..."
  1.  D ^DIR K IBAS I ($D(DTOUT))!($D(DUOUT))!(Y'>0) S IBQUIT=1 L -^IBE(351.73,IBCL) Q
  1.  S IBASNNUM=X K DIR,DIROUT,DTOUT,DUOUT,Y
  1.  I '$D(^IBE(351.73,IBCL,1,IBASNNUM)) G EDIT
  1.  S IBASDA0=$G(^IBE(351.73,IBCL,1,IBASNNUM,0)),IBBCAT=$P(IBASDA0,"^",2)
  1.  W !?3,"Bill Category for assignment # "_IBASNNUM_" is "_$P(^PRCA(430.2,IBBCAT,0),"^",1)
  1.  S IBFOTP=$$CATTYP^IBJD1(IBBCAT)
  1.  ;
  1. EDIT1 ; - Add/Edit assignment parameters
  1.  ;
  1.  N IBMINBAL,IBRCFLG
  1.  S DIR(0)="351.731,.03",DA(1)=IBCL,DA=IBASNNUM
  1.  D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 L -^IBE(351.73,IBCL) Q
  1.  S IBMINBAL=Y K DIR,DIROUT,DTOUT,DUOUT,Y
  1.  S IBRCFLG=$P($G(^IBE(351.73,IBCL,1,IBASNNUM,0)),"^",5)
  1.  S DIR(0)="Y",DIR("B")=$S(IBRCFLG=0:"NO",1:"YES")
  1.  S DIR("A")="EXCLUDE RECEIVABLES REFERRED TO RC"
  1.  S DIR("?")="^S IBOFF=67 D HELP^IBJDF8H"
  1.  D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 L -^IBE(351.73,IBCL) Q
  1.  S IBRCFLG=Y K DIR,DIROUT,DTOUT,DUOUT,Y
  1.  S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
  1.  S DR=".03///"_IBMINBAL_";.05///"_IBRCFLG D ^DIE K DIE,DR,DA
  1.  I IBFOTP="F" D FPEDIT I IBQUIT L -^IBE(351.73,IBCL) Q
  1.  I IBFOTP="T" D TPEDIT I IBQUIT L -^IBE(351.73,IBCL) Q
  1.  Q
  1.  ;
  1. FPEDIT ; - First Party edit questions
  1.  ;
  1.  N IBFPDATA,IBSDEF,IBTDEF,IBSN,IBDSLP,IBDEF
  1.  S IBFPDATA=$G(^IBE(351.73,IBCL,1,IBASNNUM,1)),IBDSLP=$P(IBFPDATA,"^",1)
  1.  S IBDEF=$S(IBDSLP'="":IBDSLP,1:45),DA(1)=IBCL
  1.  S DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM,DR="1.01//^S X=IBDEF"
  1.  D ^DIE K DIE,DA,DR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  ;
  1.  ; - Determine range of patient by name or last 4 of SSN
  1.  ;
  1.  S IBSN=$$SNL() I (IBSN="")!(IBSN="^") S IBQUIT=1 Q
  1.  ;
  1.  I IBSN="N" S IBSDEF=$P(IBFPDATA,"^",2),IBTDEF=$P(IBFPDATA,"^",3)
  1.  I IBSN="L" S IBSDEF=$P(IBFPDATA,"^",4),IBTDEF=$P(IBFPDATA,"^",5)
  1.  ;
  1. PAT S DIR(0)="FO",DIR("A")="START WITH "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
  1.  S DIR("B")=$S(IBSDEF="":"FIRST",1:IBSDEF)
  1.  S DIR("?")="^S IBOFF=33 D HELP^IBJDF8H"
  1.  D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  S IBSNF=X I X="FIRST" S IBSNF="@"
  1.  S DIR(0)="FO",DIR("A")="GO TO "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
  1.  S DIR("B")=$S(IBTDEF="":"LAST",1:IBTDEF)
  1.  S DIR("?")="^S IBOFF=40 D HELP^IBJDF8H"
  1.  D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  S IBSNL=X I X="LAST" S IBSNL="@"
  1.  I (IBSNL'="@")&($G(IBSNL)']$G(IBSNF))&($G(IBSNL)'=$G(IBSNF))&(IBSNF'="@") W !!,?3,"* The Go To Patient Name/SSN must follow after the Start With Name/SSN. *",! G PAT
  1.  S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
  1.  I IBSN="N" S DR="1.02///"_IBSNF_";1.03///"_IBSNL_";1.04///@;1.05///@" D ^DIE
  1.  I IBSN="L" S DR="1.04///"_IBSNF_";1.05///"_IBSNL_";1.02///@;1.03///@" D ^DIE
  1.  K DIE,DA,DR
  1.  L -^IBE(351.73,IBCL)
  1.  Q
  1.  ;
  1. TPEDIT ; - Third Party edit questions
  1.  ;
  1.  N IBTPDATA,IBDSLT,IBDEF
  1.  S IBTPDATA=$G(^IBE(351.73,IBCL,1,IBASNNUM,2)),IBDSLT=$P(IBTPDATA,"^",1)
  1.  S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
  1.  S IBDEF=$S(IBDSLT'="":IBDSLT,1:45),DR="2.01//^S X=IBDEF"
  1.  D ^DIE K DIE,DA,DR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  ;
  1. TYP ; - Select type of receivables to print
  1.  S DIR("A")="TYPE OF RECEIVABLE: "
  1.  I $P(IBTPDATA,"^",8) S DIR("B")=$P(IBTPDATA,"^",8)
  1.  S DIR(0)="SAX^1:INPATIENT;2:OUTPATIENT;3:PROSTHETICS;4:PHARMACY REFILL;5:ALL RECEIVABLES"
  1.  D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM,DR="2.08///"_Y
  1.  D ^DIE K DIE,DR,DA
  1.  K DIROUT,DTOUT,DUOUT,Y
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,IBRF,IBRL,IBSDEF,IBTDEF
  1. ICR S IBSDEF=$P(IBTPDATA,"^",2),IBTDEF=$P(IBTPDATA,"^",3)
  1.  S DIR(0)="FO",DIR("A")="START WITH INSURANCE CARRIER"
  1.  S DIR("B")=$S(IBSDEF="":"FIRST",1:IBSDEF)
  1.  S DIR("?")="^S IBOFF=47 D HELP^IBJDF8H"
  1.  D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  S IBRF=X I X="FIRST" S IBRF="@"
  1.  S DIR(0)="FO",DIR("A")="GO TO INSURANCE CARRIER"
  1.  S DIR("B")=$S(IBTDEF="":"LAST",1:IBTDEF)
  1.  S DIR("?")="^S IBOFF=54 D HELP^IBJDF8H"
  1.  D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  S IBRL=X I X="LAST" S IBRL="@"
  1.  I ($G(IBRL)']$G(IBRF))&($G(IBRL)'=$G(IBRF))&(IBRL'="@") W !!,?3,"* The Go to Insurance Carrier Name must follow after the Start with Insurance Carrier. *",! G ICR
  1.  S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
  1.  S DR="2.02///"_IBRF_";2.03///"_IBRL D ^DIE K DIE,DR,DA
  1.  ;
  1. NAM ; - Determine range of patients
  1.  ;
  1.  ; - Determine range of patient by name or last 4 of SSN
  1.  ;
  1.  S IBSN=$$SNL() I (IBSN="")!(IBSN="^") S IBQUIT=1 Q
  1.  ;
  1.  I IBSN="N" S IBSDEF=$P(IBTPDATA,"^",4),IBTDEF=$P(IBTPDATA,"^",5)
  1.  I IBSN="L" S IBSDEF=$P(IBTPDATA,"^",6),IBTDEF=$P(IBTPDATA,"^",7)
  1.  ;
  1. NAM1 S DIR(0)="FO",DIR("A")="START WITH "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
  1.  S DIR("B")=$S(IBSDEF="":"FIRST",1:IBSDEF)
  1.  S DIR("?")="^S IBOFF=33 D HELP^IBJDF8H"
  1.  D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  S IBSNF=X I X="FIRST" S IBSNF="@"
  1.  S DIR(0)="FO",DIR("A")="GO TO "_$S(IBSN="N":"PATIENT NAME",1:"LAST 4 OF SSN")
  1.  S DIR("B")=$S(IBTDEF="":"LAST",1:IBTDEF)
  1.  S DIR("?")="^S IBOFF=40 D HELP^IBJDF8H"
  1.  D ^DIR K DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1.  S IBSNL=X I X="LAST" S IBSNL="@"
  1.  I (IBSNL'="@")&($G(IBSNL)']$G(IBSNF))&($G(IBSNL)'=$G(IBSNF))&(IBSNF'="@") W !!,?3,"* The Go To Patient Name/SSN must follow after the Start With Name/SSN. *",! G NAM1
  1.  S DA(1)=IBCL,DIE="^IBE(351.73,"_DA(1)_",1,",DA=IBASNNUM
  1.  I IBSN="N" S DR="2.04///"_IBSNF_";2.05///"_IBSNL_";2.06///@;2.07///@" D ^DIE
  1.  I IBSN="L" S DR="2.06///"_IBSNF_";2.07///"_IBSNL_";2.04///@;2.05///@" D ^DIE
  1.  K DIE,DA,DR
  1.  ;
  1.  L -^IBE(351.73,IBCL)
  1.  Q
  1.  ;
  1. SNL() ; - Determine the patient data to be stored-either by Name or
  1.  ;   last 4 SSN
  1.  N DIR,DIRUT,DTOUT,DUOUT,DIROUT,IBSN,IBDEF,IBWLDAT
  1.  I IBFOTP="F" S IBWLDAT=$G(^IBE(351.73,IBCL,1,IBASNNUM,1)) D
  1.  . S IBDEF=$S($P(IBWLDAT,"^",2)'="":"NAME",$P(IBWLDAT,"^",3)'="":"NAME",$P(IBWLDAT,"^",4)'="":"LAST 4",$P(IBWLDAT,"^",5)'="":"LAST 4",1:"")
  1.  I IBFOTP="T" S IBWLDAT=$G(^IBE(351.73,IBCL,1,IBASNNUM,2)) D
  1.  . S IBDEF=$S($P(IBWLDAT,"^",4)'="":"NAME",$P(IBWLDAT,"^",5)'="":"NAME",$P(IBWLDAT,"^",6)'="":"LAST 4",$P(IBWLDAT,"^",7)'="":"LAST 4",1:"")
  1.  S IBSN=""
  1.  S DIR(0)="SA^N:NAME;L:LAST 4"
  1.  S DIR("A")="Sort Patients by (N)ame or (L)ast 4 of the SSN: "
  1.  I IBDEF'="" S DIR("B")=IBDEF
  1.  S DIR("?")="^D HNL^IBJD"
  1.  W ! D ^DIR K DIR I Y=""!(X="^") Q "^"
  1.  S IBSN=Y
  1.  Q IBSN
  1.  ;