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 ---[H[J[2J[HIBCNSJ52 1065 printed Dec 13, 2024@02:17:23 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 ;
