Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMZ072

IVMZ072.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ; This routine supports the IVMZ07C consistency checker routines.
  1. 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
  1. ; from the Patient Relation file ^DGPR(408.12) This file will point to an IEN in the Income Person file.
  1. ; Next, we will load all of the spouse(s) and dependents from the Income Person file into the array.
  1. N NIEN,IEN,RIEN,NODE,I,ENODE
  1. ; look into Patient Relation file #408.12. Here we will find a pointer to each relation. And the record itself will
  1. ; contain a pointer into the INCOME PERSON file (#408.13)
  1. ;
  1. ;Global ^DGPR(408.12,,DFN
  1. ;^DGPR(408.12,"B",9999955601,3206)=
  1. ; 3210)= <<------|
  1. ; 3211)= |
  1. ; 3212)= |
  1. ; ]
  1. ;Global ^DGPR(408.12,3210 <<------------
  1. ;^DGPR(408.12,3210,0)=9999955601^2^7170758;DGPR(408.13,
  1. ;^DGPR(408.12,3210,"E",0)=^408.1275D^1^1 |
  1. ;^DGPR(408.12,3210,"E",1,0)=2560406^1 |
  1. ;^DGPR(408.12,3210,"E","AID",-2560406,1)= |
  1. ;^DGPR(408.12,3210,"E","B",2560406,1)= |
  1. ; |
  1. ; |
  1. ;Global ^DGPR(408.13,7170758 <<--------------
  1. ;^DGPR(408.13,7170758,0)=XXXXXX,XXXX SPOUSE^F^2560406^^^^^^174040656P^N
  1. ; 1)=XXXXX,XXXX^^^^^^^
  1. ;
  1. I '$D(^DGPR(408.12,"B",DFN)) Q
  1. S NIEN="" F S NIEN=$O(^DGPR(408.12,"B",DFN,NIEN)) Q:NIEN="" D
  1. . Q:'$D(^DGPR(408.12,NIEN,0))
  1. . S IEN=$P(^DGPR(408.12,NIEN,0),U,3)
  1. . ; an entry in DPT is the patient. we only need relations
  1. . Q:$P(IEN,";",2)["DPT"!'IEN
  1. . Q:'$$ACTIF(NIEN,.ENODE) ;include only Active dependents
  1. . S RIEN=$P(IEN,";",1),NODE=$P(IEN,";",2)
  1. . S NODE=U_NODE,NODE=NODE_RIEN_")"
  1. . Q:'$D(@NODE)
  1. . S DGSD("DEP",RIEN,"EFF")=ENODE
  1. . S DGSD("DEP",RIEN)=$P(^DGPR(408.12,NIEN,0),U,2)
  1. . M DGSD("DEP",RIEN)=@NODE
  1. Q
  1. ;
  1. 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)...
  1. ; Input:
  1. ; NIEN = IEN of ^DGPR(408.12) reference
  1. ; ENODE = Variable to contain Effective Date
  1. ;
  1. ; Populates:
  1. ; ENODE = With the most recent effective date of changes
  1. ;
  1. ; Returns:
  1. ; ACTIVE flag
  1. ; 1 = Active
  1. ; 0 = Inactive
  1. ;
  1. N ROOT,ACTDAT,INDEX,ACTIVE,EFF
  1. S ACTIVE=0
  1. D Q ACTIVE
  1. . S ROOT=$O(^DGPR(408.12,NIEN,"E","AID","")) Q:ROOT=""
  1. . S INDEX=$O(^DGPR(408.12,NIEN,"E","AID",ROOT,"")) Q:INDEX=""
  1. . S ACTDAT=^DGPR(408.12,NIEN,"E",INDEX,0)
  1. . S ACTIVE=$P(ACTDAT,"^",2),ENODE=$P(ACTDAT,"^",1)
  1. Q ACTIVE
  1. ;