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

IBCEMCA2 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
 ;;2.0;INTEGRATED BILLING;**320**;21-MAR-1994
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 Q
 ;
CANCEL ; mass claim cancel
 NEW NS,IBIFN,NSC,DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,IBDA,IB364,DISP,IBCE
 NEW IBMCSRSC,IBMCSRNB,IBMCSCNT,IBMCSTOT,IBMCSTOP,IBMCSCAN,MRACHK,IBCAN
 D FULL^VALM1
 ;
 I '$$KCHK^XUSRB("IB AUTHORIZE") D  G CANCELX
 . W !!?5,"You don't hold the proper security key to access this option."
 . W !?5,"The necessary key is IB AUTHORIZE.  Please see your manager."
 . D PAUSE^VALM1
 . Q
 ;
 S NS=+$G(^TMP($J,"IBCEMCL",4))
 I 'NS D  G CANCELX
 . W !!?5,"There are no selected messages." D PAUSE^VALM1
 . Q
 ;
 ; count number of claims too
 S IBIFN=0 F NSC=0:1 S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN
 ;
 W !!?5,"Number of messages selected:  ",NS
 W !?7,"Number of claims selected:  ",NSC
 W !!,"In order to cancel "
 W $S(NSC=1:"this claim",1:"these claims")
 W ", you must supply the Reason Cancelled and"
 W !,"the Reason Not Billable.  These will be the default responses for "
 W $S(NSC=1:"this claim",1:"all claims")
 W "."
 ;
CANQ1 ; reader call for the Reason Cancelled field
 W !
 S DIR(0)="399,19"
 S DIR("A")="Reason Cancelled"
 D ^DIR K DIR
 I X="",Y="" W *7,!,"This is a required response. Enter '^' to exit." G CANQ1
 I $D(DIRUT) G CANCELX
 M IBMCSRSC=Y           ; save the entered text for reason cancelled
 ;
CANQ2 ; reader call for the reason not billable field
 W !
 S DIR(0)="356,.19"
 S DIR("A")="Reason Not Billable"
 D ^DIR K DIR
 I X="",Y="" W *7,!,"This is a required response. Enter '^' to exit." G CANQ2
 I $D(DIRUT) G CANCELX
 M IBMCSRNB=Y           ; save the reason not billable code/desc
 ;
 W !
 S DIR(0)="YO"
 S DIR("A")="OK to proceed into the cancel claim loop",DIR("B")="No"
 D ^DIR K DIR
 I Y'=1 G CANCELX
 ;
 S IBIFN=0,IBMCSCNT=0,IBMCSTOT=NSC,IBMCSTOP=0
 F  S IBIFN=$O(^TMP($J,"IBCEMCL",4,2,IBIFN)) Q:'IBIFN  D  Q:IBMCSTOP
 . S IBMCSCNT=IBMCSCNT+1
 . S IBDA=+$O(^TMP($J,"IBCEMCL",4,2,IBIFN,""),-1)  ; most recent 361 ien
 . S IB364=+$P($G(^IBM(361,IBDA,0)),U,11)          ; transmit bill 364 ien
 . W !!," *** Processing MCS claim# ",IBMCSCNT," of ",IBMCSTOT," ***"
 . S DISP=$$DISP^IBCEM3(IBIFN,"cancel","",1,.DIRUT)
 . ;
 . I $D(DIRUT) D  Q       ; up arrow or time-out
 .. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
 .. S DIR(0)="YO"
 .. S DIR("A")="Do you want to Exit this MCS cancel claim loop"
 .. S DIR("B")="Yes"
 .. W ! D ^DIR K DIR
 .. I Y=1 S IBMCSTOP=1    ; Yes, exit out altogether
 .. Q
 . ;
 . I 'DISP Q              ; user said No to cancel
 . ;
 . I 'IBDA!'IB364 D  Q
 .. W !?4,"Cannot determine the EDI transmission record."
 .. W !?4,"This claim can't be cancelled here."
 .. D PAUSE^VALM1
 .. Q
 . ;
 . D MRACHK^IBCECSA4 I MRACHK Q
 . ;
 . ; set-up required variables for main call to cancel this claim
 . S IBCAN=1,IBMCSCAN=1
 . S IBCE("EDI")=1
 . S Y=IBIFN
 . D
 .. ; protect variables to be restored after call to IBCC and
 .. ; leftover junk variables from IBCC
 .. NEW IBIFN,IBMCSTOP,IBMCSCNT,IBMCSTOT,IBCSAMCS
 .. NEW IBCCCC,IBCCR,IBQUIT,NAME,POP,RDATES,COL,CTRLCOL,FINISH
 .. D NOPTF^IBCC
 .. Q
 . Q
 ;
 I IBMCSTOP W !!?5,"MCS cancel loop aborted."
 I 'IBMCSTOP W !!?5,"Done with MCS cancel loop!"
 D PAUSE^VALM1
 ;
 ; rebuild the list
 KILL ^TMP($J,"IBCEMCA"),VALMHDR
 S VALMBG=1
 D UNLOCK^IBCEMCL
 D INIT^IBCEMCL
 I $G(IBCSAMCS)=1 S IBCSAMCS=2   ; flag to rebuild CSA
 ;
CANCELX ;
 S VALMBCK="R"
 Q
 ;