- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEMCA2.m
r613 r623 1 IBCEMCA2 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005 2 ;;2.0;INTEGRATED BILLING;**320,377**;21-MAR-1994;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 CANCEL ; 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,IBMCSCAC 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 ", a Reason Cancelled and a Reason Not Billable" 31 W !,"are required. You may also provide an optional CT Additional Comment." 32 W !,"These will be used as the default responses for " 33 W $S(NSC=1:"this claim",1:"all claims") 34 W "." 35 ; 36 CANQ1 ; reader call for the Reason Cancelled field 37 W ! 38 S DIR(0)="399,19" 39 S DIR("A")="Reason Cancelled" 40 D ^DIR K DIR 41 I X="",Y="" W *7,!,"This is a required response. Enter '^' to exit." G CANQ1 42 I $D(DIRUT) G CANCELX 43 M IBMCSRSC=Y ; save the entered text for reason cancelled 44 ; 45 CANQ2 ; reader call for the reason not billable field 46 W ! 47 S DIR(0)="356,.19" 48 S DIR("A")="Reason Not Billable" 49 D ^DIR K DIR 50 I X="",Y="" W *7,!,"This is a required response. Enter '^' to exit." G CANQ2 51 I $D(DIRUT) G CANCELX 52 M IBMCSRNB=Y ; save the reason not billable code/desc 53 ; 54 CANQ3 ; reader call for the Claims Tracking Additional Comment field 55 W ! 56 S DIR(0)="356,1.08O" 57 S DIR("A")="CT Additional Comment" 58 D ^DIR K DIR 59 I $D(DIRUT) G CANCELX 60 M IBMCSCAC=Y 61 ; 62 W ! 63 S DIR(0)="YO" 64 S DIR("A")="OK to proceed into the cancel claim loop",DIR("B")="No" 65 D ^DIR K DIR 66 I Y'=1 G CANCELX 67 ; 68 S IBIFN=0,IBMCSCNT=0,IBMCSTOT=NSC,IBMCSTOP=0 69 F S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN D Q:IBMCSTOP 70 . S IBMCSCNT=IBMCSCNT+1 71 . S IBDA=+$O(^TMP($J,"IBCEMCL",4,2,IBIFN,""),-1) ; most recent 361 ien 72 . S IB364=+$P($G(^IBM(361,IBDA,0)),U,11) ; transmit bill 364 ien 73 . W !!," *** Processing MCS claim# ",IBMCSCNT," of ",IBMCSTOT," ***" 74 . S DISP=$$DISP^IBCEM3(IBIFN,"cancel","",1,.DIRUT) 75 . ; 76 . I $D(DIRUT) D Q ; up arrow or time-out 77 .. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT 78 .. S DIR(0)="YO" 79 .. S DIR("A")="Do you want to Exit this MCS cancel claim loop" 80 .. S DIR("B")="Yes" 81 .. W ! D ^DIR K DIR 82 .. I Y=1 S IBMCSTOP=1 ; Yes, exit out altogether 83 .. Q 84 . ; 85 . I 'DISP Q ; user said No to cancel 86 . ; 87 . I 'IBDA!'IB364 D Q 88 .. W !?4,"Cannot determine the EDI transmission record." 89 .. W !?4,"This claim can't be cancelled here." 90 .. D PAUSE^VALM1 91 .. Q 92 . ; 93 . D MRACHK^IBCECSA4 I MRACHK Q 94 . ; 95 . ; set-up required variables for main call to cancel this claim 96 . S IBCAN=1,IBMCSCAN=1 97 . S IBCE("EDI")=1 98 . S Y=IBIFN 99 . D 100 .. ; protect variables to be restored after call to IBCC and 101 .. ; leftover junk variables from IBCC 102 .. NEW IBIFN,IBMCSTOP,IBMCSCNT,IBMCSTOT,IBCSAMCS 103 .. NEW IBCCCC,IBCCR,IBQUIT,NAME,POP,RDATES,COL,CTRLCOL,FINISH 104 .. D NOPTF^IBCC 105 .. Q 106 . Q 107 ; 108 I IBMCSTOP W !!?5,"MCS cancel loop aborted." 109 I 'IBMCSTOP W !!?5,"Done with MCS cancel loop!" 110 D PAUSE^VALM1 111 ; 112 ; rebuild the list 113 KILL ^TMP($J,"IBCEMCA"),VALMHDR 114 S VALMBG=1 115 D UNLOCK^IBCEMCL 116 D INIT^IBCEMCL 117 I $G(IBCSAMCS)=1 S IBCSAMCS=2 ; flag to rebuild CSA 118 ; 119 CANCELX ; 120 S VALMBCK="R" 121 Q 122 ; 1 IBCEMCA2 ;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 ; 7 CANCEL ; 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 ; 35 CANQ1 ; 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 ; 44 CANQ2 ; 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 ; 110 CANCELX ; 111 S VALMBCK="R" 112 Q 113 ;
Note:
See TracChangeset
for help on using the changeset viewer.
