Routine: IBCNSJ52

IBCNSJ52 ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING  (continued); 16-AUG-95

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

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

SAVE(IBCOV) ; Save off original entry, before edits

N Z

 K ^TMP($J,"IBCAT",IBCOV)

 F Z=0,1 S ^TMP($J,"IBCAT",IBCOV,Z)=$G(^IBA(355.32,IBCOV,Z))

 S ^TMP($J,"IBCAT",IBCOV,2)=$G(^IBA(355.32,IBCOV,2,0))

 S Z=0 F  S Z=$O(^IBA(355.32,IBCOV,2,Z)) Q:'Z  S ^TMP($J,"IBCAT",IBCOV,2,Z)=$G(^IBA(355.32,IBCOV,2,Z,0))

DIFFLIM(IBCOV) ; Determine if coverage was changed

 ; Returns 1 if differnce found, 0 if no difference found

 N DIFF,Z

 S DIFF=0

 F Z=0,1 I $G(^TMP($J,"IBCAT",IBCOV,Z))'=$G(^IBA(355.32,IBCOV,Z)) S DIFF=1 G DLEX

 I $G(^TMP($J,"IBCAT",IBCOV,2))'=$G(^IBA(355.32,IBCOV,2,0)) S DIFF=1 G DLEX

 S Z=0 F  S Z=$O(^IBA(355.32,IBCOV,2,Z)) Q:'Z  D  G:DIFF DLEX

 .I $G(^TMP($J,"IBCAT",IBCOV,2,Z))'=$G(^IBA(355.32,IBCOV,2,Z,0)) S DIFF=1 Q

 .K ^TMP($J,"IBCAT",IBCOV,2,Z)

 I $O(^TMP($J,"IBCAT",IBCOV,2,"")) S DIFF=1

DLEX Q DIFF

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSJ52   1065     printed  Mar 13, 2025@21:22:21                                                                                                                                                                                                    Page 2

IBCNSJ52  ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING  (continued); 16-AUG-95

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

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

 +3       ;

SAVE(IBCOV) ; Save off original entry, before edits

 +1        NEW Z

 +2        KILL ^TMP($JOB,"IBCAT",IBCOV)

 +3        FOR Z=0,1

               SET ^TMP($JOB,"IBCAT",IBCOV,Z)=$GET(^IBA(355.32,IBCOV,Z))

 +4        SET ^TMP($JOB,"IBCAT",IBCOV,2)=$GET(^IBA(355.32,IBCOV,2,0))

 +5        SET Z=0

FOR

               SET Z=$ORDER(^IBA(355.32,IBCOV,2,Z))

               if 'Z

                   QUIT

               SET ^TMP($JOB,"IBCAT",IBCOV,2,Z)=$GET(^IBA(355.32,IBCOV,2,Z,0))

 +6        QUIT

 +7       ;

DIFFLIM(IBCOV) ; Determine if coverage was changed

 +1       ; Returns 1 if differnce found, 0 if no difference found

 +2        NEW DIFF,Z

 +3        SET DIFF=0

 +4        FOR Z=0,1

               IF $GET(^TMP($JOB,"IBCAT",IBCOV,Z))'=$GET(^IBA(355.32,IBCOV,Z))

                   SET DIFF=1

                   GOTO DLEX

 +5        IF $GET(^TMP($JOB,"IBCAT",IBCOV,2))'=$GET(^IBA(355.32,IBCOV,2,0))

               SET DIFF=1

               GOTO DLEX

 +6        SET Z=0

FOR

               SET Z=$ORDER(^IBA(355.32,IBCOV,2,Z))

               if 'Z

                   QUIT

               Begin DoDot:1

 +7                IF $GET(^TMP($JOB,"IBCAT",IBCOV,2,Z))'=$GET(^IBA(355.32,IBCOV,2,Z,0))

                       SET DIFF=1

                       QUIT

 +8                KILL ^TMP($JOB,"IBCAT",IBCOV,2,Z)

               End DoDot:1

               if DIFF

                   GOTO DLEX

 +9        IF $ORDER(^TMP($JOB,"IBCAT",IBCOV,2,""))

               SET DIFF=1

DLEX       QUIT DIFF

 +1       ;

IBCNSJ52.m