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

IBCEM3.m

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