source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEMCA2.m@ 724

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

revised back to 6/30/08 version

File size: 3.4 KB
Line 
1IBCEMCA2 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
2 ;;2.0;INTEGRATED BILLING;**320**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7CANCEL ; mass claim cancel
8 NEW NS,IBIFN,NSC,DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,IBDA,IB364,DISP,IBCE
9 NEW IBMCSRSC,IBMCSRNB,IBMCSCNT,IBMCSTOT,IBMCSTOP,IBMCSCAN,MRACHK,IBCAN
10 D FULL^VALM1
11 ;
12 I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELX
13 . W !!?5,"You don't hold the proper security key to access this option."
14 . W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
15 . D PAUSE^VALM1
16 . Q
17 ;
18 S NS=+$G(^TMP($J,"IBCEMCL",4))
19 I 'NS D G CANCELX
20 . W !!?5,"There are no selected messages." D PAUSE^VALM1
21 . Q
22 ;
23 ; count number of claims too
24 S IBIFN=0 F NSC=0:1 S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN
25 ;
26 W !!?5,"Number of messages selected: ",NS
27 W !?7,"Number of claims selected: ",NSC
28 W !!,"In order to cancel "
29 W $S(NSC=1:"this claim",1:"these claims")
30 W ", you must supply the Reason Cancelled and"
31 W !,"the Reason Not Billable. These will be the default responses for "
32 W $S(NSC=1:"this claim",1:"all claims")
33 W "."
34 ;
35CANQ1 ; reader call for the Reason Cancelled field
36 W !
37 S DIR(0)="399,19"
38 S DIR("A")="Reason Cancelled"
39 D ^DIR K DIR
40 I X="",Y="" W *7,!,"This is a required response. Enter '^' to exit." G CANQ1
41 I $D(DIRUT) G CANCELX
42 M IBMCSRSC=Y ; save the entered text for reason cancelled
43 ;
44CANQ2 ; reader call for the reason not billable field
45 W !
46 S DIR(0)="356,.19"
47 S DIR("A")="Reason Not Billable"
48 D ^DIR K DIR
49 I X="",Y="" W *7,!,"This is a required response. Enter '^' to exit." G CANQ2
50 I $D(DIRUT) G CANCELX
51 M IBMCSRNB=Y ; save the reason not billable code/desc
52 ;
53 W !
54 S DIR(0)="YO"
55 S DIR("A")="OK to proceed into the cancel claim loop",DIR("B")="No"
56 D ^DIR K DIR
57 I Y'=1 G CANCELX
58 ;
59 S IBIFN=0,IBMCSCNT=0,IBMCSTOT=NSC,IBMCSTOP=0
60 F S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN D Q:IBMCSTOP
61 . S IBMCSCNT=IBMCSCNT+1
62 . S IBDA=+$O(^TMP($J,"IBCEMCL",4,2,IBIFN,""),-1) ; most recent 361 ien
63 . S IB364=+$P($G(^IBM(361,IBDA,0)),U,11) ; transmit bill 364 ien
64 . W !!," *** Processing MCS claim# ",IBMCSCNT," of ",IBMCSTOT," ***"
65 . S DISP=$$DISP^IBCEM3(IBIFN,"cancel","",1,.DIRUT)
66 . ;
67 . I $D(DIRUT) D Q ; up arrow or time-out
68 .. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
69 .. S DIR(0)="YO"
70 .. S DIR("A")="Do you want to Exit this MCS cancel claim loop"
71 .. S DIR("B")="Yes"
72 .. W ! D ^DIR K DIR
73 .. I Y=1 S IBMCSTOP=1 ; Yes, exit out altogether
74 .. Q
75 . ;
76 . I 'DISP Q ; user said No to cancel
77 . ;
78 . I 'IBDA!'IB364 D Q
79 .. W !?4,"Cannot determine the EDI transmission record."
80 .. W !?4,"This claim can't be cancelled here."
81 .. D PAUSE^VALM1
82 .. Q
83 . ;
84 . D MRACHK^IBCECSA4 I MRACHK Q
85 . ;
86 . ; set-up required variables for main call to cancel this claim
87 . S IBCAN=1,IBMCSCAN=1
88 . S IBCE("EDI")=1
89 . S Y=IBIFN
90 . D
91 .. ; protect variables to be restored after call to IBCC and
92 .. ; leftover junk variables from IBCC
93 .. NEW IBIFN,IBMCSTOP,IBMCSCNT,IBMCSTOT,IBCSAMCS
94 .. NEW IBCCCC,IBCCR,IBQUIT,NAME,POP,RDATES,COL,CTRLCOL,FINISH
95 .. D NOPTF^IBCC
96 .. Q
97 . Q
98 ;
99 I IBMCSTOP W !!?5,"MCS cancel loop aborted."
100 I 'IBMCSTOP W !!?5,"Done with MCS cancel loop!"
101 D PAUSE^VALM1
102 ;
103 ; rebuild the list
104 KILL ^TMP($J,"IBCEMCA"),VALMHDR
105 S VALMBG=1
106 D UNLOCK^IBCEMCL
107 D INIT^IBCEMCL
108 I $G(IBCSAMCS)=1 S IBCSAMCS=2 ; flag to rebuild CSA
109 ;
110CANCELX ;
111 S VALMBCK="R"
112 Q
113 ;
Note: See TracBrowser for help on using the repository browser.