IBCEXTR2 ;ALB/JEH - IB EXTRACT STATUS MANAGEMENT ;01/14/00
;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-1994
;;Per VHA Directive 10-93-142, this routine should not be modified.
;This routine contains the action items to cancel,clone and authorize
;claims held in a ready for extract statue due to EDI/MRA parameters
;being turned off.
;
CANCEL ;Cancel bill
N IBIFN,IBDA,IB364,IBCEAUTO
S IBCEAUTO=1
;
; Check for security key
I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELQ
. D FULL^VALM1
. W !!?5,"You don't hold the proper security key to access this function."
. W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
. D PAUSE^VALM1
. Q
;
D SEL(.IBDA,1)
S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=$P($G(IBDA(+IBDA)),U,2)
I 'IBIFN G CANCELQ
D CANCEL^IBCEM3(.IBDA,IBIFN,IB364)
D PAUSE^VALM1
CANCELQ S VALMBCK="R"
I $G(IBDA)'="" D BLD^IBCEXTR1
Q
;
CPYCLN ;Cancel/clone/authorize bill
N IBIFN,IBDA,IB364,IBCEAUTO,IBNIEN,IBYY
S IBCEAUTO=1
;
; Check for security key
I '$$KCHK^XUSRB("IB AUTHORIZE") D G CPYCLNQ
. D FULL^VALM1
. W !!?5,"You don't hold the proper security key to access this function."
. W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
. D PAUSE^VALM1
. Q
;
D SEL(.IBDA,1)
S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=$P($G(IBDA(+IBDA)),U,2)
I 'IBIFN G CPYCLNQ
D COPYCLON^IBCECOB2(IBIFN,IB364,.IBDA) ;Cancel/copy bill
I '$G(IBNIEN) D PAUSE^VALM1 G CPYCLNQ
S IBIFN=IBNIEN
S DIE="^DGCR(399,",DA=IBIFN,DR="[IB STATUS]",IBYY="@902" D ^DIE K DIE,DA,DR,IBNIEN ;Authorize bill quietly
W !,"Authorizing bill..."
D ARONLY^IBCB1(IBIFN) ;Pass to AR as new bill
D PAUSE^VALM1
;
CPYCLNQ ;
S VALMBCK="R"
K IBCEAUTO
Q
;
SEL(IBDA,ONE) ;Select entry from List Manager
;D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=$P($G(^TMP("IBCERP61",$J,IBDA)),U,2,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEXTR2 1981 printed Apr 09, 2024@21:28:29 Page 2
IBCEXTR2 ;ALB/JEH - IB EXTRACT STATUS MANAGEMENT ;01/14/00
+1 ;;2.0;INTEGRATED BILLING;**137,155**;21-MAR-1994
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;This routine contains the action items to cancel,clone and authorize
+4 ;claims held in a ready for extract statue due to EDI/MRA parameters
+5 ;being turned off.
+6 ;
CANCEL ;Cancel bill
+1 NEW IBIFN,IBDA,IB364,IBCEAUTO
+2 SET IBCEAUTO=1
+3 ;
+4 ; Check for security key
+5 IF '$$KCHK^XUSRB("IB AUTHORIZE")
Begin DoDot:1
+6 DO FULL^VALM1
+7 WRITE !!?5,"You don't hold the proper security key to access this function."
+8 WRITE !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
+9 DO PAUSE^VALM1
+10 QUIT
End DoDot:1
GOTO CANCELQ
+11 ;
+12 DO SEL(.IBDA,1)
+13 SET IBDA=$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(+IBDA))
SET IB364=$PIECE($GET(IBDA(+IBDA)),U,2)
+14 IF 'IBIFN
GOTO CANCELQ
+15 DO CANCEL^IBCEM3(.IBDA,IBIFN,IB364)
+16 DO PAUSE^VALM1
CANCELQ SET VALMBCK="R"
+1 IF $GET(IBDA)'=""
DO BLD^IBCEXTR1
+2 QUIT
+3 ;
CPYCLN ;Cancel/clone/authorize bill
+1 NEW IBIFN,IBDA,IB364,IBCEAUTO,IBNIEN,IBYY
+2 SET IBCEAUTO=1
+3 ;
+4 ; Check for security key
+5 IF '$$KCHK^XUSRB("IB AUTHORIZE")
Begin DoDot:1
+6 DO FULL^VALM1
+7 WRITE !!?5,"You don't hold the proper security key to access this function."
+8 WRITE !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
+9 DO PAUSE^VALM1
+10 QUIT
End DoDot:1
GOTO CPYCLNQ
+11 ;
+12 DO SEL(.IBDA,1)
+13 SET IBDA=$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(+IBDA))
SET IB364=$PIECE($GET(IBDA(+IBDA)),U,2)
+14 IF 'IBIFN
GOTO CPYCLNQ
+15 ;Cancel/copy bill
DO COPYCLON^IBCECOB2(IBIFN,IB364,.IBDA)
+16 IF '$GET(IBNIEN)
DO PAUSE^VALM1
GOTO CPYCLNQ
+17 SET IBIFN=IBNIEN
+18 ;Authorize bill quietly
SET DIE="^DGCR(399,"
SET DA=IBIFN
SET DR="[IB STATUS]"
SET IBYY="@902"
DO ^DIE
KILL DIE,DA,DR,IBNIEN
+19 WRITE !,"Authorizing bill..."
+20 ;Pass to AR as new bill
DO ARONLY^IBCB1(IBIFN)
+21 DO PAUSE^VALM1
+22 ;
CPYCLNQ ;
+1 SET VALMBCK="R"
+2 KILL IBCEAUTO
+3 QUIT
+4 ;
SEL(IBDA,ONE) ;Select entry from List Manager
+1 ;D FULL^VALM1
+2 DO EN^VALM2($GET(XQORNOD(0)),$SELECT('$GET(ONE):"",1:"S"))
+3 SET IBDA=0
FOR
SET IBDA=$ORDER(VALMY(IBDA))
if 'IBDA
QUIT
SET IBDA(IBDA)=$PIECE($GET(^TMP("IBCERP61",$JOB,IBDA)),U,2,3)
+4 QUIT
