| 1 | IVMUCHK ;ALB/MLI - Filter routine to validate MT transmission before filing ; August 31,1994
 | 
|---|
| 2 |  ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  ; This routine will perform edit checks to validate the means test data
 | 
|---|
| 6 |  ; before it is uploaded into the MAS Means Test files.  Any errors will
 | 
|---|
| 7 |  ; be recorded and will be sent automatically to the IVM Center for
 | 
|---|
| 8 |  ; processing.
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ; called from IVMUM1 before upload routine is invoked
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 |  ; input:
 | 
|---|
| 13 |  ;   HLDA as IEN of the HL7 file entry
 | 
|---|
| 14 |  ;   HL* - all other HL7 variables expected
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  ; output:
 | 
|---|
| 17 |  ;   IVMMTERR as error condition found (free text)
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 | EN() ; entry point to create temp array and begin filter checks
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 |  N ARRAY,DEP,ERROR,I,IEN,STRING,TYPE,X
 | 
|---|
| 24 |  S ERROR=""
 | 
|---|
| 25 |  F IEN=1:0 S IEN=$O(^HL(772,HLDA,"IN",IEN)) Q:'IEN!(ERROR]"")  I $E($G(^(IEN,0)),1,3)="PID" D
 | 
|---|
| 26 |  . K ARRAY S (DEP,SPOUSE)=0
 | 
|---|
| 27 |  . S ARRAY("PID")=$P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999) ; pid segment
 | 
|---|
| 28 |  . S ARRAY("ZIC")=$$ORDER(HLDA,.IEN),$P(ARRAY("ZIC"),HLFS,21)=$$TOTAL(ARRAY("ZIC"))
 | 
|---|
| 29 |  . S ARRAY("ZIR")=$$ORDER(HLDA,.IEN)
 | 
|---|
| 30 |  . F IEN=IEN:0 S IEN=$O(^HL(772,HLDA,"IN",IEN)) Q:'IEN!($E($G(^(IEN,0)),1,3)="ZMT")  D
 | 
|---|
| 31 |  . . S DEP=DEP+1
 | 
|---|
| 32 |  . . S ARRAY(DEP,"ZDP")=$$CLEAR($P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
 | 
|---|
| 33 |  . . S ARRAY(DEP,"ZIC")=$$ORDER(HLDA,.IEN)
 | 
|---|
| 34 |  . . S ARRAY(DEP,"ZIR")=$$ORDER(HLDA,.IEN)
 | 
|---|
| 35 |  . . I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)'="^^" S SPOUSE=DEP
 | 
|---|
| 36 |  . . I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)="^^" K ARRAY(DEP) S DEP=DEP-1
 | 
|---|
| 37 |  . . I DEP S $P(ARRAY(DEP,"ZIC"),HLFS,21)=$$TOTAL(ARRAY(DEP,"ZIC"),ARRAY(DEP,"ZIR"),ARRAY(DEP,"ZDP"))
 | 
|---|
| 38 |  . S ARRAY("ZMT")=$$CLEAR($P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
 | 
|---|
| 39 |  . S ERROR=$$CHECK()
 | 
|---|
| 40 |  Q ERROR
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 | CHECK() ; check validity of transmission data
 | 
|---|
| 44 |  ;
 | 
|---|
| 45 |  ; Output:  error message (first one found)
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 |  N ERROR,IEN
 | 
|---|
| 48 |  S ERROR=$$ZIC^IVMUCHK2(ARRAY("ZIC"))
 | 
|---|
| 49 |  I ERROR']"" S ERROR=$$ZIR^IVMUCHK1(ARRAY("ZIR"))
 | 
|---|
| 50 |  I ERROR']"" S ERROR=$$ZMT^IVMUCHK4(ARRAY("ZMT"))
 | 
|---|
| 51 |  I ERROR']"" F IEN=0:0 S IEN=$O(ARRAY(IEN)) Q:'IEN  D  I ERROR]"" G CHECKQ ; check dependent segments
 | 
|---|
| 52 |  . S ERROR=$$ZDP^IVMUCHK3(ARRAY(IEN,"ZDP"),IEN)
 | 
|---|
| 53 |  . I ERROR']"" S ERROR=$$ZIC^IVMUCHK2(ARRAY(IEN,"ZIC"),IEN)
 | 
|---|
| 54 |  . I ERROR']"" S ERROR=$$ZIR^IVMUCHK1(ARRAY(IEN,"ZIR"),IEN)
 | 
|---|
| 55 | CHECKQ Q $G(ERROR)
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 |  ;
 | 
|---|
| 58 | ORDER(HLDA,IEN) ; get next node
 | 
|---|
| 59 |  S IEN=$O(^HL(772,HLDA,"IN",IEN))
 | 
|---|
| 60 |  Q $$CLEAR($P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 | CLEAR(NODE) ; convert HLQ to null
 | 
|---|
| 64 |  N I
 | 
|---|
| 65 |  F I=1:1:25 I $P(NODE,HLFS,I)=HLQ S $P(NODE,HLFS,I)=""
 | 
|---|
| 66 |  Q NODE
 | 
|---|
| 67 |  ;
 | 
|---|
| 68 |  ;
 | 
|---|
| 69 | TOTAL(STRING,INCR,DEP) ; append total on the end
 | 
|---|
| 70 |  N I,D,N,INC,DEB,NET S (INC,DEB,NET)=""
 | 
|---|
| 71 | INC ; income
 | 
|---|
| 72 |  I $D(INCR),$P($G(DEP),HLFS,6)'=2,'$P(INCR,HLFS,9) S INC=0 G DEBT
 | 
|---|
| 73 |  F I=3:1:12 S INC=$G(INC)+$P(STRING,HLFS,I)
 | 
|---|
| 74 | DEBT ; debts
 | 
|---|
| 75 |  F I=13:1:15 S DEB=$G(DEB)+$P(STRING,HLFS,I)
 | 
|---|
| 76 | NET ; net worth
 | 
|---|
| 77 |  F I=16:1:19 I $P(STRING,HLFS,I)]"" S NET=$G(NET)+$P(STRING,HLFS,I)
 | 
|---|
| 78 |  I NET]"" S NET=NET-$P(STRING,HLFS,20)
 | 
|---|
| 79 |  Q INC_HLFS_DEB_HLFS_NET
 | 
|---|