IBCEM3 ;ALB/TMP - IB ELECTRONIC MESSAGE MGMNT ACTIONS ;18-AUG-1999
;;2.0;INTEGRATED BILLING;**137,155,320**;21-MAR-1994
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
CANCEL(IBDA,IBIFN,IB364) ; Generic cancel bill action
; IBDA = entry selected from list (pass by reference-value is returned)
; IBIFN = ien of bill entry in file 399
; IB364 = ien of transmitted bill entry in file 364
;
N Y,IBCAN,IBCE,IBTDA,IB0
I 'IBDA!'IBIFN S IBDA="" G CANCELQ
I '$$CANCKS("C",IBIFN) S IBDA="" G CANCELQ
;
S (IBCAN,IBCE("EDI"))=1,Y=IBIFN
I $G(IBCEAUTO) S IBCAN=2
N IBQUIT
D NOPTF^IBCC S:$P($G(^DGCR(399,IBIFN,0)),U,13)'=7 IBDA=""
I '$G(IBCEAUTO) D PAUSE^VALM1
CANCELQ Q
;
CANCKS(FUNC,IBIFN) ; Check validity of cancel or cancel/clone function
;FUNC = "C" for cancel "CC" for cancel/clone
;IBIFN = bill internal entry #
N ERR
S ERR=""
I '$$DISP(IBIFN,"cancel"_$S(FUNC="C":"",1:"/clone")) S ERR="<No action taken>"
I ERR'="" W !,*7,ERR D PAUSE^VALM1
Q (ERR="")
;
EBILL(IBDA,IBIFN,IB364) ;Generic edit bill action
N IBAC,IBBDA,IBTDA,IB0,IBV,DFN,IBDA1,IBELOOP,IB399,IBDAB,IBHOLD,IB399TX,IBNEED,IBPOPOUT,IBTXPRT
S IB399=$G(^DGCR(399,+IBIFN,0))
S IB399TX=$G(^DGCR(399,+IBIFN,"TX")),IBNEED=$$NEEDMRA^IBEFUNC(IBIFN)
I $P($G(^DGCR(399,IBIFN,0)),U,13)'<3 D G EBILLQ
. N DIR
. S DIR(0)="EA",DIR("A",1)="You cannot edit a bill with a status of "_$$EXPAND^IBTRE(399,.13,$P($G(^DGCR(399,IBIFN,0)),U,13))
. S DIR("A")="Enter RETURN to continue or '^' to exit:"
. D ^DIR
. S IBDA=""
I '$$DISP(IBIFN,"edit") S IBDA="" G EBILLQ
S IBAC=1,DFN=$P($G(^DGCR(399,IBIFN,0)),U,2),IBV=0
S IBHOLD("IBIFN")=IBIFN,IBHOLD("IBDA")=$G(IBDA)
; Warning - do not use IBH variable when calling the following routine
D ST^IBCB,ENS^%ZISS
D:$D(IBIFN) PAUSE^VALM1
S IBIFN=IBHOLD("IBIFN"),IBDA=IBHOLD("IBDA")
I $S(IBNEED:$P($G(^DGCR(399,IBIFN,0)),U,13)'=2,1:$P($G(^DGCR(399,IBIFN,0)),U,13)'=3) S IBDA=""
I IBDA D
. S $P(^DGCR(399,IBIFN,"S"),U,10,11)=(DT_U_DUZ)
. S DIK="^DGCR(399,",DA=IBIFN F DIK(1)=10,11 D EN1^DIK
. D UPDEDI^IBCEM(IB364,"E")
EBILLQ Q
;
DISP(IBIFN,FUNC,DISP,IBDEF,DIRUT) ;Display bill detail
; Returns 1 if function should continue, 0 if function should not
; IBIFN = Bill #
; FUNC = Text (lower case) to describe function to perform
; DISP = flag = 1 for return data, no display
; format: 1^BILL #^PATIENT^BILL TYPE^DATES
; IBDEF = Default answer for Yes/No question here (1=Yes)
; DIRUT = output parameter is defined if passed by reference,
; = this will be defined if the user enters a leading up-arrow
; = or times out or enters a null response
;
; Function returns Y and DIRUT - used by IBCEMCA2 - DO NOT NEW THESE
;
N IBB0,IBBU,IBNO,STAT,DIR,DTOUT,DUOUT,IBV
S IBB0=$G(^DGCR(399,IBIFN,0)),IBBU=$G(^("U")),IBNO=$P(IBB0,U)
S IBV(1)=$P($G(^DPT(+$P(IBB0,U,2),0)),U)_$S($P($G(^(0)),U,9)'="":" ("_$P(^(0),U,9)_")",1:"")
S IBV(2)=$$EXPAND^IBTRE(399,.05,$P(IBB0,U,5))
S IBV(3)=$$EXPAND^IBTRE(399,151,$P(IBBU,U))_" - "_$$EXPAND^IBTRE(399,151,$P(IBBU,U,2))
;
I '$G(DISP) D G DISPQ
. S (DIR("A",1),DIR("A",6))=" ",STAT=1
. S DIR("A",2)=" Bill #: "_IBNO
. S DIR("A",3)=" Patient: "_IBV(1)
. S DIR("A",4)=" Bill Type: "_IBV(2)
. S DIR("A",5)="Bill Dates: "_IBV(3)
. S DIR("A")="Are you sure this is the bill you want to "_FUNC_"? "
. S DIR("B")="NO"
. I $G(IBDEF) S DIR("B")="Yes"
. S DIR(0)="YA" D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT)!'Y S STAT=0
S STAT="1^"_IBNO_U_IBV(1)_U_IBV(2)_U_IBV(3)
DISPQ ;
Q STAT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEM3 3592 printed Dec 13, 2024@02:10:46 Page 2
IBCEM3 ;ALB/TMP - IB ELECTRONIC MESSAGE MGMNT ACTIONS ;18-AUG-1999
+1 ;;2.0;INTEGRATED BILLING;**137,155,320**;21-MAR-1994
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
CANCEL(IBDA,IBIFN,IB364) ; Generic cancel bill action
+1 ; IBDA = entry selected from list (pass by reference-value is returned)
+2 ; IBIFN = ien of bill entry in file 399
+3 ; IB364 = ien of transmitted bill entry in file 364
+4 ;
+5 NEW Y,IBCAN,IBCE,IBTDA,IB0
+6 IF 'IBDA!'IBIFN
SET IBDA=""
GOTO CANCELQ
+7 IF '$$CANCKS("C",IBIFN)
SET IBDA=""
GOTO CANCELQ
+8 ;
+9 SET (IBCAN,IBCE("EDI"))=1
SET Y=IBIFN
+10 IF $GET(IBCEAUTO)
SET IBCAN=2
+11 NEW IBQUIT
+12 DO NOPTF^IBCC
if $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)'=7
SET IBDA=""
+13 IF '$GET(IBCEAUTO)
DO PAUSE^VALM1
CANCELQ QUIT
+1 ;
CANCKS(FUNC,IBIFN) ; Check validity of cancel or cancel/clone function
+1 ;FUNC = "C" for cancel "CC" for cancel/clone
+2 ;IBIFN = bill internal entry #
+3 NEW ERR
+4 SET ERR=""
+5 IF '$$DISP(IBIFN,"cancel"_$SELECT(FUNC="C":"",1:"/clone"))
SET ERR="<No action taken>"
+6 IF ERR'=""
WRITE !,*7,ERR
DO PAUSE^VALM1
+7 QUIT (ERR="")
+8 ;
EBILL(IBDA,IBIFN,IB364) ;Generic edit bill action
+1 NEW IBAC,IBBDA,IBTDA,IB0,IBV,DFN,IBDA1,IBELOOP,IB399,IBDAB,IBHOLD,IB399TX,IBNEED,IBPOPOUT,IBTXPRT
+2 SET IB399=$GET(^DGCR(399,+IBIFN,0))
+3 SET IB399TX=$GET(^DGCR(399,+IBIFN,"TX"))
SET IBNEED=$$NEEDMRA^IBEFUNC(IBIFN)
+4 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)'<3
Begin DoDot:1
+5 NEW DIR
+6 SET DIR(0)="EA"
SET DIR("A",1)="You cannot edit a bill with a status of "_$$EXPAND^IBTRE(399,.13,$PIECE($GET(^DGCR(399,IBIFN,0)),U,13))
+7 SET DIR("A")="Enter RETURN to continue or '^' to exit:"
+8 DO ^DIR
+9 SET IBDA=""
End DoDot:1
GOTO EBILLQ
+10 IF '$$DISP(IBIFN,"edit")
SET IBDA=""
GOTO EBILLQ
+11 SET IBAC=1
SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
SET IBV=0
+12 SET IBHOLD("IBIFN")=IBIFN
SET IBHOLD("IBDA")=$GET(IBDA)
+13 ; Warning - do not use IBH variable when calling the following routine
+14 DO ST^IBCB
DO ENS^%ZISS
+15 if $DATA(IBIFN)
DO PAUSE^VALM1
+16 SET IBIFN=IBHOLD("IBIFN")
SET IBDA=IBHOLD("IBDA")
+17 IF $SELECT(IBNEED:$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)'=2,1:$PIECE($GET(^DGCR(399,IBIFN,0)),U,13)'=3)
SET IBDA=""
+18 IF IBDA
Begin DoDot:1
+19 SET $PIECE(^DGCR(399,IBIFN,"S"),U,10,11)=(DT_U_DUZ)
+20 SET DIK="^DGCR(399,"
SET DA=IBIFN
FOR DIK(1)=10,11
DO EN1^DIK
+21 DO UPDEDI^IBCEM(IB364,"E")
End DoDot:1
EBILLQ QUIT
+1 ;
DISP(IBIFN,FUNC,DISP,IBDEF,DIRUT) ;Display bill detail
+1 ; Returns 1 if function should continue, 0 if function should not
+2 ; IBIFN = Bill #
+3 ; FUNC = Text (lower case) to describe function to perform
+4 ; DISP = flag = 1 for return data, no display
+5 ; format: 1^BILL #^PATIENT^BILL TYPE^DATES
+6 ; IBDEF = Default answer for Yes/No question here (1=Yes)
+7 ; DIRUT = output parameter is defined if passed by reference,
+8 ; = this will be defined if the user enters a leading up-arrow
+9 ; = or times out or enters a null response
+10 ;
+11 ; Function returns Y and DIRUT - used by IBCEMCA2 - DO NOT NEW THESE
+12 ;
+13 NEW IBB0,IBBU,IBNO,STAT,DIR,DTOUT,DUOUT,IBV
+14 SET IBB0=$GET(^DGCR(399,IBIFN,0))
SET IBBU=$GET(^("U"))
SET IBNO=$PIECE(IBB0,U)
+15 SET IBV(1)=$PIECE($GET(^DPT(+$PIECE(IBB0,U,2),0)),U)_$SELECT($PIECE($GET(^(0)),U,9)'="":" ("_$PIECE(^(0),U,9)_")",1:"")
+16 SET IBV(2)=$$EXPAND^IBTRE(399,.05,$PIECE(IBB0,U,5))
+17 SET IBV(3)=$$EXPAND^IBTRE(399,151,$PIECE(IBBU,U))_" - "_$$EXPAND^IBTRE(399,151,$PIECE(IBBU,U,2))
+18 ;
+19 IF '$GET(DISP)
Begin DoDot:1
+20 SET (DIR("A",1),DIR("A",6))=" "
SET STAT=1
+21 SET DIR("A",2)=" Bill #: "_IBNO
+22 SET DIR("A",3)=" Patient: "_IBV(1)
+23 SET DIR("A",4)=" Bill Type: "_IBV(2)
+24 SET DIR("A",5)="Bill Dates: "_IBV(3)
+25 SET DIR("A")="Are you sure this is the bill you want to "_FUNC_"? "
+26 SET DIR("B")="NO"
+27 IF $GET(IBDEF)
SET DIR("B")="Yes"
+28 SET DIR(0)="YA"
DO ^DIR
KILL DIR
+29 IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET STAT=0
End DoDot:1
GOTO DISPQ
+30 SET STAT="1^"_IBNO_U_IBV(1)_U_IBV(2)_U_IBV(3)
DISPQ ;
+1 QUIT STAT
+2 ;
