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