IBCEMCA2 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
;;2.0;INTEGRATED BILLING;**320,377**;21-MAR-1994;Build 23
;;Per VHA Directive 2004-038, 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,IBMCSCAC
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 ", a Reason Cancelled and a Reason Not Billable"
W !,"are required. You may also provide an optional CT Additional Comment."
W !,"These will be used as 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
;
CANQ3 ; reader call for the Claims Tracking Additional Comment field
W !
S DIR(0)="356,1.08O"
S DIR("A")="CT Additional Comment"
D ^DIR K DIR
I $D(DIRUT) G CANCELX
M IBMCSCAC=Y
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMCA2 3878 printed Nov 22, 2024@17:20:56 Page 2
IBCEMCA2 ;ALB/ESG - Multiple CSA Message Management - Actions ;20-SEP-2005
+1 ;;2.0;INTEGRATED BILLING;**320,377**;21-MAR-1994;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CANCEL ; mass claim cancel
+1 NEW NS,IBIFN,NSC,DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT,IBDA,IB364,DISP,IBCE
+2 NEW IBMCSRSC,IBMCSRNB,IBMCSCNT,IBMCSTOT,IBMCSTOP,IBMCSCAN,MRACHK,IBCAN,IBMCSCAC
+3 DO FULL^VALM1
+4 ;
+5 IF '$$KCHK^XUSRB("IB AUTHORIZE")
Begin DoDot:1
+6 WRITE !!?5,"You don't hold the proper security key to access this option."
+7 WRITE !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
+8 DO PAUSE^VALM1
+9 QUIT
End DoDot:1
GOTO CANCELX
+10 ;
+11 SET NS=+$GET(^TMP($JOB,"IBCEMCL",4))
+12 IF 'NS
Begin DoDot:1
+13 WRITE !!?5,"There are no selected messages."
DO PAUSE^VALM1
+14 QUIT
End DoDot:1
GOTO CANCELX
+15 ;
+16 ; count number of claims too
+17 SET IBIFN=0
FOR NSC=0:1
SET IBIFN=$ORDER(^TMP($JOB,"IBCEMCL",4,2,IBIFN))
if 'IBIFN
QUIT
+18 ;
+19 WRITE !!?5,"Number of messages selected: ",NS
+20 WRITE !?7,"Number of claims selected: ",NSC
+21 WRITE !!,"In order to cancel "
+22 WRITE $SELECT(NSC=1:"this claim",1:"these claims")
+23 WRITE ", a Reason Cancelled and a Reason Not Billable"
+24 WRITE !,"are required. You may also provide an optional CT Additional Comment."
+25 WRITE !,"These will be used as the default responses for "
+26 WRITE $SELECT(NSC=1:"this claim",1:"all claims")
+27 WRITE "."
+28 ;
CANQ1 ; reader call for the Reason Cancelled field
+1 WRITE !
+2 SET DIR(0)="399,19"
+3 SET DIR("A")="Reason Cancelled"
+4 DO ^DIR
KILL DIR
+5 IF X=""
IF Y=""
WRITE *7,!,"This is a required response. Enter '^' to exit."
GOTO CANQ1
+6 IF $DATA(DIRUT)
GOTO CANCELX
+7 ; save the entered text for reason cancelled
MERGE IBMCSRSC=Y
+8 ;
CANQ2 ; reader call for the reason not billable field
+1 WRITE !
+2 SET DIR(0)="356,.19"
+3 SET DIR("A")="Reason Not Billable"
+4 DO ^DIR
KILL DIR
+5 IF X=""
IF Y=""
WRITE *7,!,"This is a required response. Enter '^' to exit."
GOTO CANQ2
+6 IF $DATA(DIRUT)
GOTO CANCELX
+7 ; save the reason not billable code/desc
MERGE IBMCSRNB=Y
+8 ;
CANQ3 ; reader call for the Claims Tracking Additional Comment field
+1 WRITE !
+2 SET DIR(0)="356,1.08O"
+3 SET DIR("A")="CT Additional Comment"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO CANCELX
+6 MERGE IBMCSCAC=Y
+7 ;
+8 WRITE !
+9 SET DIR(0)="YO"
+10 SET DIR("A")="OK to proceed into the cancel claim loop"
SET DIR("B")="No"
+11 DO ^DIR
KILL DIR
+12 IF Y'=1
GOTO CANCELX
+13 ;
+14 SET IBIFN=0
SET IBMCSCNT=0
SET IBMCSTOT=NSC
SET IBMCSTOP=0
+15 FOR
SET IBIFN=$ORDER(^TMP($JOB,"IBCEMCL",4,2,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+16 SET IBMCSCNT=IBMCSCNT+1
+17 ; most recent 361 ien
SET IBDA=+$ORDER(^TMP($JOB,"IBCEMCL",4,2,IBIFN,""),-1)
+18 ; transmit bill 364 ien
SET IB364=+$PIECE($GET(^IBM(361,IBDA,0)),U,11)
+19 WRITE !!," *** Processing MCS claim# ",IBMCSCNT," of ",IBMCSTOT," ***"
+20 SET DISP=$$DISP^IBCEM3(IBIFN,"cancel","",1,.DIRUT)
+21 ;
+22 ; up arrow or time-out
IF $DATA(DIRUT)
Begin DoDot:2
+23 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+24 SET DIR(0)="YO"
+25 SET DIR("A")="Do you want to Exit this MCS cancel claim loop"
+26 SET DIR("B")="Yes"
+27 WRITE !
DO ^DIR
KILL DIR
+28 ; Yes, exit out altogether
IF Y=1
SET IBMCSTOP=1
+29 QUIT
End DoDot:2
QUIT
+30 ;
+31 ; user said No to cancel
IF 'DISP
QUIT
+32 ;
+33 IF 'IBDA!'IB364
Begin DoDot:2
+34 WRITE !?4,"Cannot determine the EDI transmission record."
+35 WRITE !?4,"This claim can't be cancelled here."
+36 DO PAUSE^VALM1
+37 QUIT
End DoDot:2
QUIT
+38 ;
+39 DO MRACHK^IBCECSA4
IF MRACHK
QUIT
+40 ;
+41 ; set-up required variables for main call to cancel this claim
+42 SET IBCAN=1
SET IBMCSCAN=1
+43 SET IBCE("EDI")=1
+44 SET Y=IBIFN
+45 Begin DoDot:2
+46 ; protect variables to be restored after call to IBCC and
+47 ; leftover junk variables from IBCC
+48 NEW IBIFN,IBMCSTOP,IBMCSCNT,IBMCSTOT,IBCSAMCS
+49 NEW IBCCCC,IBCCR,IBQUIT,NAME,POP,RDATES,COL,CTRLCOL,FINISH
+50 DO NOPTF^IBCC
+51 QUIT
End DoDot:2
+52 QUIT
End DoDot:1
if IBMCSTOP
QUIT
+53 ;
+54 IF IBMCSTOP
WRITE !!?5,"MCS cancel loop aborted."
+55 IF 'IBMCSTOP
WRITE !!?5,"Done with MCS cancel loop!"
+56 DO PAUSE^VALM1
+57 ;
+58 ; rebuild the list
+59 KILL ^TMP($JOB,"IBCEMCA"),VALMHDR
+60 SET VALMBG=1
+61 DO UNLOCK^IBCEMCL
+62 DO INIT^IBCEMCL
+63 ; flag to rebuild CSA
IF $GET(IBCSAMCS)=1
SET IBCSAMCS=2
+64 ;
CANCELX ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
