source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM3.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1IBCEM3 ;ALB/TMP - IB ELECTRONIC MESSAGE MGMNT ACTIONS ;18-AUG-1999
2 ;;2.0;INTEGRATED BILLING;**137,155,320**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CANCEL(IBDA,IBIFN,IB364) ; Generic cancel bill action
6 ; IBDA = entry selected from list (pass by reference-value is returned)
7 ; IBIFN = ien of bill entry in file 399
8 ; IB364 = ien of transmitted bill entry in file 364
9 ;
10 N Y,IBCAN,IBCE,IBTDA,IB0
11 I 'IBDA!'IBIFN S IBDA="" G CANCELQ
12 I '$$CANCKS("C",IBIFN) S IBDA="" G CANCELQ
13 ;
14 S (IBCAN,IBCE("EDI"))=1,Y=IBIFN
15 I $G(IBCEAUTO) S IBCAN=2
16 N IBQUIT
17 D NOPTF^IBCC S:$P($G(^DGCR(399,IBIFN,0)),U,13)'=7 IBDA=""
18 I '$G(IBCEAUTO) D PAUSE^VALM1
19CANCELQ Q
20 ;
21CANCKS(FUNC,IBIFN) ; Check validity of cancel or cancel/clone function
22 ;FUNC = "C" for cancel "CC" for cancel/clone
23 ;IBIFN = bill internal entry #
24 N ERR
25 S ERR=""
26 I '$$DISP(IBIFN,"cancel"_$S(FUNC="C":"",1:"/clone")) S ERR="<No action taken>"
27 I ERR'="" W !,*7,ERR D PAUSE^VALM1
28 Q (ERR="")
29 ;
30EBILL(IBDA,IBIFN,IB364) ;Generic edit bill action
31 N IBAC,IBBDA,IBTDA,IB0,IBV,DFN,IBDA1,IBELOOP,IB399,IBDAB,IBHOLD,IB399TX,IBNEED,IBPOPOUT,IBTXPRT
32 S IB399=$G(^DGCR(399,+IBIFN,0))
33 S IB399TX=$G(^DGCR(399,+IBIFN,"TX")),IBNEED=$$NEEDMRA^IBEFUNC(IBIFN)
34 I $P($G(^DGCR(399,IBIFN,0)),U,13)'<3 D G EBILLQ
35 . N DIR
36 . 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))
37 . S DIR("A")="Enter RETURN to continue or '^' to exit:"
38 . D ^DIR
39 . S IBDA=""
40 I '$$DISP(IBIFN,"edit") S IBDA="" G EBILLQ
41 S IBAC=1,DFN=$P($G(^DGCR(399,IBIFN,0)),U,2),IBV=0
42 S IBHOLD("IBIFN")=IBIFN,IBHOLD("IBDA")=$G(IBDA)
43 ; Warning - do not use IBH variable when calling the following routine
44 D ST^IBCB,ENS^%ZISS
45 D:$D(IBIFN) PAUSE^VALM1
46 S IBIFN=IBHOLD("IBIFN"),IBDA=IBHOLD("IBDA")
47 I $S(IBNEED:$P($G(^DGCR(399,IBIFN,0)),U,13)'=2,1:$P($G(^DGCR(399,IBIFN,0)),U,13)'=3) S IBDA=""
48 I IBDA D
49 . S $P(^DGCR(399,IBIFN,"S"),U,10,11)=(DT_U_DUZ)
50 . S DIK="^DGCR(399,",DA=IBIFN F DIK(1)=10,11 D EN1^DIK
51 . D UPDEDI^IBCEM(IB364,"E")
52EBILLQ Q
53 ;
54DISP(IBIFN,FUNC,DISP,IBDEF,DIRUT) ;Display bill detail
55 ; Returns 1 if function should continue, 0 if function should not
56 ; IBIFN = Bill #
57 ; FUNC = Text (lower case) to describe function to perform
58 ; DISP = flag = 1 for return data, no display
59 ; format: 1^BILL #^PATIENT^BILL TYPE^DATES
60 ; IBDEF = Default answer for Yes/No question here (1=Yes)
61 ; DIRUT = output parameter is defined if passed by reference,
62 ; = this will be defined if the user enters a leading up-arrow
63 ; = or times out or enters a null response
64 ;
65 ; Function returns Y and DIRUT - used by IBCEMCA2 - DO NOT NEW THESE
66 ;
67 N IBB0,IBBU,IBNO,STAT,DIR,DTOUT,DUOUT,IBV
68 S IBB0=$G(^DGCR(399,IBIFN,0)),IBBU=$G(^("U")),IBNO=$P(IBB0,U)
69 S IBV(1)=$P($G(^DPT(+$P(IBB0,U,2),0)),U)_$S($P($G(^(0)),U,9)'="":" ("_$P(^(0),U,9)_")",1:"")
70 S IBV(2)=$$EXPAND^IBTRE(399,.05,$P(IBB0,U,5))
71 S IBV(3)=$$EXPAND^IBTRE(399,151,$P(IBBU,U))_" - "_$$EXPAND^IBTRE(399,151,$P(IBBU,U,2))
72 ;
73 I '$G(DISP) D G DISPQ
74 . S (DIR("A",1),DIR("A",6))=" ",STAT=1
75 . S DIR("A",2)=" Bill #: "_IBNO
76 . S DIR("A",3)=" Patient: "_IBV(1)
77 . S DIR("A",4)=" Bill Type: "_IBV(2)
78 . S DIR("A",5)="Bill Dates: "_IBV(3)
79 . S DIR("A")="Are you sure this is the bill you want to "_FUNC_"? "
80 . S DIR("B")="NO"
81 . I $G(IBDEF) S DIR("B")="Yes"
82 . S DIR(0)="YA" D ^DIR K DIR
83 . I $D(DTOUT)!$D(DUOUT)!'Y S STAT=0
84 S STAT="1^"_IBNO_U_IBV(1)_U_IBV(2)_U_IBV(3)
85DISPQ ;
86 Q STAT
87 ;
Note: See TracBrowser for help on using the repository browser.