IBCNSD1.m

IBCNSD1 ;ALB/NLR - BU EDIT TEMPLATES ; 10-JUN-93

 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

ED(IBE) ;

 D SAVEBU

 S DIE="^IBA(355.5,",DA=IBCBU

 S DR=IBE

 L +^IBA(355.5,+IBCBU):5 I '$T D LOCKED^IBTRCD1 G EDQ

 D ^DIE K DIE

 D COMP

 I IBDIF=1 D EDUP

EDQ L -^IBA(355.5,+IBCBU)

 D EXIT

 Q

 ;

SAVEBU ;

 K ^TMP($J,"IBBU")

 S ^TMP($J,"IBBU",355.5,IBCBU,0)=$G(^IBA(355.5,IBCBU,0))

 S ^TMP($J,"IBBU",355.5,IBCBU,1)=$G(^IBA(355.5,IBCBU,1))

 Q

COMP ;

 S IBDIF=0

 I $G(^IBA(355.5,DA,0))'=^TMP($J,"IBBU",355.5,DA,0) S IBDIF=1 Q

 I $G(^IBA(355.5,DA,1))'=^TMP($J,"IBBU",355.5,DA,1) S IBDIF=1 Q

 Q

EDUP ; -- enter date and user if editing has taken place

 S DIE="^IBA(355.5,",DA=IBCBU

 S DR="1.05///NOW;1.06////"_DUZ

 D ^DIE K DIE

 Q

CY ;

 S IBYR1=IBYR K IBYR D INIT^IBCNSD

 I $D(VALMQUIT) S IBYR=IBYR1 K VALMQUIT D EXITRP

 I IBYR=IBYR1 D

 .K IBYR1,VALMQUIT D EXITRP

 E  D EXIT

 Q

 ;

EXIT I $G(IBDIF) D HDR^IBCNSA("Benefits Used"),BLD^IBCNSD

EXITRP S VALMBCK="R"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCNSD1   1068     printed  Apr 09, 2024@21:07:34                                                                                                                                                                                                     Page 2

IBCNSD1   ;ALB/NLR - BU EDIT TEMPLATES ; 10-JUN-93

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

ED(IBE)   ;

 +1        DO SAVEBU

 +2        SET DIE="^IBA(355.5,"

           SET DA=IBCBU

 +3        SET DR=IBE

 +4        LOCK +^IBA(355.5,+IBCBU):5

           IF '$TEST

               DO LOCKED^IBTRCD1

               GOTO EDQ

 +5        DO ^DIE

           KILL DIE

 +6        DO COMP

 +7        IF IBDIF=1

               DO EDUP

EDQ        LOCK -^IBA(355.5,+IBCBU)

 +1        DO EXIT

 +2        QUIT 

 +3       ;

SAVEBU    ;

 +1        KILL ^TMP($JOB,"IBBU")

 +2        SET ^TMP($JOB,"IBBU",355.5,IBCBU,0)=$GET(^IBA(355.5,IBCBU,0))

 +3        SET ^TMP($JOB,"IBBU",355.5,IBCBU,1)=$GET(^IBA(355.5,IBCBU,1))

 +4        QUIT 

COMP      ;

 +1        SET IBDIF=0

 +2        IF $GET(^IBA(355.5,DA,0))'=^TMP($JOB,"IBBU",355.5,DA,0)

               SET IBDIF=1

               QUIT 

 +3        IF $GET(^IBA(355.5,DA,1))'=^TMP($JOB,"IBBU",355.5,DA,1)

               SET IBDIF=1

               QUIT 

 +4        QUIT 

EDUP      ; -- enter date and user if editing has taken place

 +1        SET DIE="^IBA(355.5,"

           SET DA=IBCBU

 +2        SET DR="1.05///NOW;1.06////"_DUZ

 +3        DO ^DIE

           KILL DIE

 +4        QUIT 

CY        ;

 +1        SET IBYR1=IBYR

           KILL IBYR

           DO INIT^IBCNSD

 +2        IF $DATA(VALMQUIT)

               SET IBYR=IBYR1

               KILL VALMQUIT

               DO EXITRP

 +3        IF IBYR=IBYR1

               Begin DoDot:1

 +4                KILL IBYR1,VALMQUIT

                   DO EXITRP

               End DoDot:1

 +5       IF '$TEST

               DO EXIT

 +6        QUIT 

 +7       ;

EXIT       IF $GET(IBDIF)

               DO HDR^IBCNSA("Benefits Used")

               DO BLD^IBCNSD

EXITRP     SET VALMBCK="R"

 +1        QUIT