IBCNSJ52.m

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))

 Q

 ;

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 ---IBCNSJ52   1065     printed  Apr 09, 2024@21:26:28                                                                                                                                                                                                    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       ;