source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSJ52.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1IBCNSJ52 ;ALB/TMP - INSURANCE PLAN MAINTENANCE ACTION PROCESSING (continued); 16-AUG-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**43**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SAVE(IBCOV) ; Save off original entry, before edits
6 N Z
7 K ^TMP($J,"IBCAT",IBCOV)
8 F Z=0,1 S ^TMP($J,"IBCAT",IBCOV,Z)=$G(^IBA(355.32,IBCOV,Z))
9 S ^TMP($J,"IBCAT",IBCOV,2)=$G(^IBA(355.32,IBCOV,2,0))
10 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))
11 Q
12 ;
13DIFFLIM(IBCOV) ; Determine if coverage was changed
14 ; Returns 1 if differnce found, 0 if no difference found
15 N DIFF,Z
16 S DIFF=0
17 F Z=0,1 I $G(^TMP($J,"IBCAT",IBCOV,Z))'=$G(^IBA(355.32,IBCOV,Z)) S DIFF=1 G DLEX
18 I $G(^TMP($J,"IBCAT",IBCOV,2))'=$G(^IBA(355.32,IBCOV,2,0)) S DIFF=1 G DLEX
19 S Z=0 F S Z=$O(^IBA(355.32,IBCOV,2,Z)) Q:'Z D G:DIFF DLEX
20 .I $G(^TMP($J,"IBCAT",IBCOV,2,Z))'=$G(^IBA(355.32,IBCOV,2,Z,0)) S DIFF=1 Q
21 .K ^TMP($J,"IBCAT",IBCOV,2,Z)
22 I $O(^TMP($J,"IBCAT",IBCOV,2,"")) S DIFF=1
23DLEX Q DIFF
24 ;
Note: See TracBrowser for help on using the repository browser.