- 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 23, 2025@18:16:48 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 ;