- 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 Feb 18, 2025@23:37:11 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 ;