IVMZ072 ;BAJ/PHH - HL7 Z07 CONSISTENCY CHECKER -- DRIVER ROUTINE II ; 05/22/08
;;2.0;INCOME VERIFICATION MATCH;**105,130**;JUL 8,1996;Build 2
;
;
; This routine supports the IVMZ07C consistency checker routines.
LOADSD(DFN,DGSD) ; Load spouse & dependent data into array
; We will need to look at the Patient Relationship file to determine the spouse(s) and dependents for the patient
; from the Patient Relation file ^DGPR(408.12) This file will point to an IEN in the Income Person file.
; Next, we will load all of the spouse(s) and dependents from the Income Person file into the array.
N NIEN,IEN,RIEN,NODE,I,ENODE
; look into Patient Relation file #408.12. Here we will find a pointer to each relation. And the record itself will
; contain a pointer into the INCOME PERSON file (#408.13)
;
;Global ^DGPR(408.12,,DFN
;^DGPR(408.12,"B",9999955601,3206)=
; 3210)= <<------|
; 3211)= |
; 3212)= |
; ]
;Global ^DGPR(408.12,3210 <<------------
;^DGPR(408.12,3210,0)=9999955601^2^7170758;DGPR(408.13,
;^DGPR(408.12,3210,"E",0)=^408.1275D^1^1 |
;^DGPR(408.12,3210,"E",1,0)=2560406^1 |
;^DGPR(408.12,3210,"E","AID",-2560406,1)= |
;^DGPR(408.12,3210,"E","B",2560406,1)= |
; |
; |
;Global ^DGPR(408.13,7170758 <<--------------
;^DGPR(408.13,7170758,0)=XXXXXX,XXXX SPOUSE^F^2560406^^^^^^174040656P^N
; 1)=XXXXX,XXXX^^^^^^^
;
I '$D(^DGPR(408.12,"B",DFN)) Q
S NIEN="" F S NIEN=$O(^DGPR(408.12,"B",DFN,NIEN)) Q:NIEN="" D
. Q:'$D(^DGPR(408.12,NIEN,0))
. S IEN=$P(^DGPR(408.12,NIEN,0),U,3)
. ; an entry in DPT is the patient. we only need relations
. Q:$P(IEN,";",2)["DPT"!'IEN
. Q:'$$ACTIF(NIEN,.ENODE) ;include only Active dependents
. S RIEN=$P(IEN,";",1),NODE=$P(IEN,";",2)
. S NODE=U_NODE,NODE=NODE_RIEN_")"
. Q:'$D(@NODE)
. S DGSD("DEP",RIEN,"EFF")=ENODE
. S DGSD("DEP",RIEN)=$P(^DGPR(408.12,NIEN,0),U,2)
. M DGSD("DEP",RIEN)=@NODE
Q
;
ACTIF(NIEN,ENODE) ;determine if record in ^DGPR(408.12) is currently active. If active, populate variable ENODE with Effective Date.
; This API should be called something like this I $$ACTIF^IVMZ072(NIEN,.ENODE)...
; Input:
; NIEN = IEN of ^DGPR(408.12) reference
; ENODE = Variable to contain Effective Date
;
; Populates:
; ENODE = With the most recent effective date of changes
;
; Returns:
; ACTIVE flag
; 1 = Active
; 0 = Inactive
;
N ROOT,ACTDAT,INDEX,ACTIVE,EFF
S ACTIVE=0
D Q ACTIVE
. S ROOT=$O(^DGPR(408.12,NIEN,"E","AID","")) Q:ROOT=""
. S INDEX=$O(^DGPR(408.12,NIEN,"E","AID",ROOT,"")) Q:INDEX=""
. S ACTDAT=^DGPR(408.12,NIEN,"E",INDEX,0)
. S ACTIVE=$P(ACTDAT,"^",2),ENODE=$P(ACTDAT,"^",1)
Q ACTIVE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMZ072 3038 printed Apr 09, 2024@21:03:32 Page 2
IVMZ072 ;BAJ/PHH - HL7 Z07 CONSISTENCY CHECKER -- DRIVER ROUTINE II ; 05/22/08
+1 ;;2.0;INCOME VERIFICATION MATCH;**105,130**;JUL 8,1996;Build 2
+2 ;
+3 ;
+4 ; This routine supports the IVMZ07C consistency checker routines.
LOADSD(DFN,DGSD) ; Load spouse & dependent data into array
+1 ; We will need to look at the Patient Relationship file to determine the spouse(s) and dependents for the patient
+2 ; from the Patient Relation file ^DGPR(408.12) This file will point to an IEN in the Income Person file.
+3 ; Next, we will load all of the spouse(s) and dependents from the Income Person file into the array.
+4 NEW NIEN,IEN,RIEN,NODE,I,ENODE
+5 ; look into Patient Relation file #408.12. Here we will find a pointer to each relation. And the record itself will
+6 ; contain a pointer into the INCOME PERSON file (#408.13)
+7 ;
+8 ;Global ^DGPR(408.12,,DFN
+9 ;^DGPR(408.12,"B",9999955601,3206)=
+10 ; 3210)= <<------|
+11 ; 3211)= |
+12 ; 3212)= |
+13 ; ]
+14 ;Global ^DGPR(408.12,3210 <<------------
+15 ;^DGPR(408.12,3210,0)=9999955601^2^7170758;DGPR(408.13,
+16 ;^DGPR(408.12,3210,"E",0)=^408.1275D^1^1 |
+17 ;^DGPR(408.12,3210,"E",1,0)=2560406^1 |
+18 ;^DGPR(408.12,3210,"E","AID",-2560406,1)= |
+19 ;^DGPR(408.12,3210,"E","B",2560406,1)= |
+20 ; |
+21 ; |
+22 ;Global ^DGPR(408.13,7170758 <<--------------
+23 ;^DGPR(408.13,7170758,0)=XXXXXX,XXXX SPOUSE^F^2560406^^^^^^174040656P^N
+24 ; 1)=XXXXX,XXXX^^^^^^^
+25 ;
+26 IF '$DATA(^DGPR(408.12,"B",DFN))
QUIT
+27 SET NIEN=""
FOR
SET NIEN=$ORDER(^DGPR(408.12,"B",DFN,NIEN))
if NIEN=""
QUIT
Begin DoDot:1
+28 if '$DATA(^DGPR(408.12,NIEN,0))
QUIT
+29 SET IEN=$PIECE(^DGPR(408.12,NIEN,0),U,3)
+30 ; an entry in DPT is the patient. we only need relations
+31 if $PIECE(IEN,";",2)["DPT"!'IEN
QUIT
+32 ;include only Active dependents
if '$$ACTIF(NIEN,.ENODE)
QUIT
+33 SET RIEN=$PIECE(IEN,";",1)
SET NODE=$PIECE(IEN,";",2)
+34 SET NODE=U_NODE
SET NODE=NODE_RIEN_")"
+35 if '$DATA(@NODE)
QUIT
+36 SET DGSD("DEP",RIEN,"EFF")=ENODE
+37 SET DGSD("DEP",RIEN)=$PIECE(^DGPR(408.12,NIEN,0),U,2)
+38 MERGE DGSD("DEP",RIEN)=@NODE
End DoDot:1
+39 QUIT
+40 ;
ACTIF(NIEN,ENODE) ;determine if record in ^DGPR(408.12) is currently active. If active, populate variable ENODE with Effective Date.
+1 ; This API should be called something like this I $$ACTIF^IVMZ072(NIEN,.ENODE)...
+2 ; Input:
+3 ; NIEN = IEN of ^DGPR(408.12) reference
+4 ; ENODE = Variable to contain Effective Date
+5 ;
+6 ; Populates:
+7 ; ENODE = With the most recent effective date of changes
+8 ;
+9 ; Returns:
+10 ; ACTIVE flag
+11 ; 1 = Active
+12 ; 0 = Inactive
+13 ;
+14 NEW ROOT,ACTDAT,INDEX,ACTIVE,EFF
+15 SET ACTIVE=0
+16 Begin DoDot:1
+17 SET ROOT=$ORDER(^DGPR(408.12,NIEN,"E","AID",""))
if ROOT=""
QUIT
+18 SET INDEX=$ORDER(^DGPR(408.12,NIEN,"E","AID",ROOT,""))
if INDEX=""
QUIT
+19 SET ACTDAT=^DGPR(408.12,NIEN,"E",INDEX,0)
+20 SET ACTIVE=$PIECE(ACTDAT,"^",2)
SET ENODE=$PIECE(ACTDAT,"^",1)
End DoDot:1
QUIT ACTIVE
+21 QUIT ACTIVE
+22 ;
