source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUCHK.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1IVMUCHK ;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 ;
19EN() ; 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 ;
43CHECK() ; 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)
55CHECKQ Q $G(ERROR)
56 ;
57 ;
58ORDER(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 ;
63CLEAR(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 ;
69TOTAL(STRING,INCR,DEP) ; append total on the end
70 N I,D,N,INC,DEB,NET S (INC,DEB,NET)=""
71INC ; 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)
74DEBT ; debts
75 F I=13:1:15 S DEB=$G(DEB)+$P(STRING,HLFS,I)
76NET ; 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
Note: See TracBrowser for help on using the repository browser.