source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMZ072.m@ 1638

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

revised back to 6/30/08 version

File size: 2.9 KB
RevLine 
[623]1IVMZ072 ;BAJ - HL7 Z07 CONSISTENCY CHECKER -- DRIVER ROUTINE II ; 09/27/06
2 ;;2.0;INCOME VERIFICATION MATCH;**105**;JUL 8,1996;Build 2
3 ;
4 ;
5 ; This routine supports the IVMZ07C consistency checker routines.
6LOADSD(DFN,DGSD) ; Load spouse & dependent data into array
7 ; We will need to look at the Patient Relationship file to determine the spouse(s) and dependents for the patient
8 ; from the Patient Relation file ^DGPR(408.12) This file will point to an IEN in the Income Person file.
9 ; Next, we will load all of the spouse(s) and dependents from the Income Person file into the array.
10 N NIEN,IEN,RIEN,NODE,I,ENODE
11 ; look into Patient Relation file #408.12. Here we will find a pointer to each relation. And the record itself will
12 ; contain a pointer into the INCOME PERSON file (#408.13)
13 ;
14 ;Global ^DGPR(408.12,,DFN
15 ;^DGPR(408.12,"B",9999955601,3206)=
16 ; 3210)= <<------|
17 ; 3211)= |
18 ; 3212)= |
19 ; ]
20 ;Global ^DGPR(408.12,3210 <<------------
21 ;^DGPR(408.12,3210,0)=9999955601^2^7170758;DGPR(408.13,
22 ;^DGPR(408.12,3210,"E",0)=^408.1275D^1^1 |
23 ;^DGPR(408.12,3210,"E",1,0)=2560406^1 |
24 ;^DGPR(408.12,3210,"E","AID",-2560406,1)= |
25 ;^DGPR(408.12,3210,"E","B",2560406,1)= |
26 ; |
27 ; |
28 ;Global ^DGPR(408.13,7170758 <<--------------
29 ;^DGPR(408.13,7170758,0)=XXXXXX,XXXX SPOUSE^F^2560406^^^^^^174040656P^N
30 ; 1)=XXXXX,XXXX^^^^^^^
31 ;
32 I '$D(^DGPR(408.12,"B",DFN)) Q
33 S NIEN="" F S NIEN=$O(^DGPR(408.12,"B",DFN,NIEN)) Q:NIEN="" D
34 . S IEN=$P(^DGPR(408.12,NIEN,0),U,3)
35 . ; an entry in DPT is the patient. we only need relations
36 . Q:$P(IEN,";",2)["DPT"
37 . Q:'$$ACTIF(NIEN,.ENODE) ;include only Active dependents
38 . S RIEN=$P(IEN,";",1),NODE=$P(IEN,";",2)
39 . S NODE=U_NODE,NODE=NODE_RIEN_")"
40 . Q:'$D(@NODE)
41 . S DGSD("DEP",RIEN,"EFF")=ENODE
42 . S DGSD("DEP",RIEN)=$P(^DGPR(408.12,NIEN,0),U,2)
43 . M DGSD("DEP",RIEN)=@NODE
44 Q
45 ;
46ACTIF(NIEN,ENODE) ;determine if record in ^DGPR(408.12) is currently active. If active, populate variable ENODE with Effective Date.
47 ; This API should be called something like this I $$ACTIF^IVMZ072(NIEN,.ENODE)...
48 ; Input:
49 ; NIEN = IEN of ^DGPR(408.12) reference
50 ; ENODE = Variable to contain Effective Date
51 ;
52 ; Populates:
53 ; ENODE = With the most recent effective date of changes
54 ;
55 ; Returns:
56 ; ACTIVE flag
57 ; 1 = Active
58 ; 0 = Inactive
59 ;
60 N ROOT,ACTDAT,INDEX,ACTIVE,EFF
61 S ACTIVE=0
62 D Q ACTIVE
63 . S ROOT=$O(^DGPR(408.12,NIEN,"E","AID","")) Q:ROOT=""
64 . S INDEX=$O(^DGPR(408.12,NIEN,"E","AID",ROOT,"")) Q:INDEX=""
65 . S ACTDAT=^DGPR(408.12,NIEN,"E",INDEX,0)
66 . S ACTIVE=$P(ACTDAT,"^",2),ENODE=$P(ACTDAT,"^",1)
67 Q ACTIVE
68 ;
Note: See TracBrowser for help on using the repository browser.