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

IBECEA51.m

Go to the documentation of this file.
  1. IBECEA51 ;ALB/CPM - Cancel/Edit/Add... Update Event Actions ; 05-MAY-93
  1. ;;Version 2.0 ; INTEGRATED BILLING ;**57**; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. CS ; 'Change Status' Entry Action
  1. N DIE,DA,DR,IBCOMMIT,IBLINE,IBNDX,IBSTAT,IBDEST,IBNBR,IBN
  1. S IBCOMMIT=0 D EN^VALM2($G(XQORNOD(0))) I '$O(VALMY(0)) G CSQ
  1. S IBNBR="" F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D
  1. .S IBLINE=^TMP("IBACME",$J,IBNBR,0),IBNDX=^TMP("IBACMEI",$J,IBNBR)
  1. .S IBSTAT=$P(IBNDX,"^"),IBN=$P(IBNDX,"^",3)
  1. .S IBDEST=$S(IBSTAT="OPEN":"CLOSED",1:"OPEN")
  1. .W !!,"Processing Event #",IBNBR,":"
  1. .Q:$$FEE(IBN)
  1. .S DIR(0)="Y",DIR("A")="Change the status of this event from "_IBSTAT_" to "_IBDEST,DIR("?")="^D HCS^IBECEA51"
  1. .D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) W !,"This event will remain "_IBSTAT_"." Q
  1. .S DIE="^IB(",DA=IBN,DR=".05////"_$S(IBDEST="OPEN":1,1:2)
  1. .D ^DIE I $D(Y) W !,"An error occured while changing the status - event is still ",IBSTAT,"." Q
  1. .S IBCOMMIT=1 W !,"The status has been changed to ",IBDEST,"."
  1. .S IBLINE=$$SETSTR^VALM1(IBDEST,IBLINE,+$P(VALMDDF("STATUS"),"^",2),+$P(VALMDDF("STATUS"),"^",3))
  1. .S ^TMP("IBACME",$J,IBNBR,0)=IBLINE,$P(^TMP("IBACMEI",$J,IBNBR),"^",1)=IBDEST
  1. D PAUSE^VALM1
  1. CSQ S VALMBCK=$S(IBCOMMIT:"R",1:"")
  1. Q
  1. ;
  1. HCS ; Help for 'Change Status'
  1. W !!,"Please enter 'Y' or 'YES' to change the status of this event from ",IBSTAT
  1. W !,"to ",IBDEST,", or 'N', 'NO', or '^' to quit."
  1. W !!,"If the status of this event is changed to open, and the patient is still an"
  1. W !,"inpatient in this ward (on the specified admission date), charges will be"
  1. W !,"billed starting the day after the Date Last Calculated. If the status is"
  1. W !,"changed to closed, no further charges will be associated with this event."
  1. Q
  1. ;
  1. LC ; 'Last Date Calc' Entry Action
  1. N IBCOMMIT,IBNBR
  1. S IBCOMMIT=0 D EN^VALM2($G(XQORNOD(0))) I '$O(VALMY(0)) G LCQ
  1. S IBNBR="" F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D LCO
  1. D PAUSE^VALM1
  1. LCQ S VALMBCK=$S(IBCOMMIT:"R",1:"")
  1. Q
  1. ;
  1. LCO ; Update Last Calc Date for a Single Event.
  1. N DIE,DR,DA,IBLINE,IBNDX,IBLCAL,IBN,IBEVDT,IBNEWV,%DT
  1. S IBLINE=^TMP("IBACME",$J,IBNBR,0),IBNDX=^TMP("IBACMEI",$J,IBNBR)
  1. S IBLCAL=$P(IBNDX,"^",2),IBN=$P(IBNDX,"^",3),IBEVDT=$P(IBNDX,"^",4)
  1. W !!,"Processing Event #",IBNBR,":"
  1. I $$FEE(IBN) G LCOQ
  1. LCP W !,"Date Last Calculated: " W:IBLCAL $$DAT2^IBOUTL(IBLCAL),"// "
  1. R X:DTIME S:'IBLCAL&(X="") X="^" S:'$T X="^" I $E(X)="^" G LCOQ
  1. I X="" W " (",$$DAT2^IBOUTL(IBLCAL),")",!,"No change!" G LCOQ
  1. I $E(X)="?"!($E(X)="@") D HLC G LCP
  1. S %DT="EPX" D ^%DT I Y<0 D HELP^%DTC G LCP
  1. I Y<IBEVDT!(Y>$$FMADD^XLFDT(DT,-1)) D HLC G LCP
  1. S IBNEWV=Y,DIE="^IB(",DA=IBN,DR=".18////"_Y
  1. D ^DIE I $D(Y) W !,"An error occured while changing the Last Calc Date - no change made!" G LCOQ
  1. S IBCOMMIT=1 W !,"The Date Last Calculated has been changed to ",$$DAT1^IBOUTL(IBNEWV),"."
  1. S IBLINE=$$SETSTR^VALM1($$DAT1^IBOUTL(IBNEWV),IBLINE,+$P(VALMDDF("LCALC"),"^",2),+$P(VALMDDF("LCALC"),"^",3))
  1. S ^TMP("IBACME",$J,IBNBR,0)=IBLINE,$P(^TMP("IBACMEI",$J,IBNBR),"^",2)=IBNEWV
  1. LCOQ Q
  1. ;
  1. HLC ; Help for 'Last Calc Date'
  1. W !!,"The Date Last Calculated is used to record the last date for which Means Test"
  1. W !,"charges were billed for an admission."
  1. W !!,"This date cannot be deleted. Please enter a date not less than the Event"
  1. W !,"Date (",$$DAT1^IBOUTL(IBEVDT),") and not greater than yesterday (",$$DAT1^IBOUTL($$FMADD^XLFDT(DT,-1)),").",!
  1. Q
  1. ;
  1. ;
  1. FEE(IBN) ; If the Event Record is for Fee, it is uneditable.
  1. ; Input: IBN -- Pointer to an event record in file #350
  1. ; Output: IBFEE -- 1 = record is uneditable
  1. ; 0 = record is editable
  1. N IBFEE S IBFEE=0
  1. I $P($G(^IB(+$G(IBN),0)),"^",8)["FEE" S IBFEE=1 W !,*7,"Fee Admissions cannot be edited!"
  1. FEEQ Q IBFEE