Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEMCA2

IBCEMCA2.m

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