IBCEXTR2.m

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 ---IBCEXTR2   1981     printed  Mar 13, 2025@21:17:30                                                                                                                                                                                                    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