| 1 | IVMZ072 ;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.
|
|---|
| 6 | LOADSD(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 | ;
|
|---|
| 46 | ACTIF(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 | ;
|
|---|
