IVMUCHK ;ALB/MLI - Filter routine to validate MT transmission before filing ; August 31,1994
;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine will perform edit checks to validate the means test data
; before it is uploaded into the MAS Means Test files. Any errors will
; be recorded and will be sent automatically to the IVM Center for
; processing.
;
; called from IVMUM1 before upload routine is invoked
;
; input:
; HLDA as IEN of the HL7 file entry
; HL* - all other HL7 variables expected
;
; output:
; IVMMTERR as error condition found (free text)
;
EN() ; entry point to create temp array and begin filter checks
;
;
;
N ARRAY,DEP,ERROR,I,IEN,STRING,TYPE,X
S ERROR=""
F IEN=1:0 S IEN=$O(^HL(772,HLDA,"IN",IEN)) Q:'IEN!(ERROR]"") I $E($G(^(IEN,0)),1,3)="PID" D
. K ARRAY S (DEP,SPOUSE)=0
. S ARRAY("PID")=$P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999) ; pid segment
. S ARRAY("ZIC")=$$ORDER(HLDA,.IEN),$P(ARRAY("ZIC"),HLFS,21)=$$TOTAL(ARRAY("ZIC"))
. S ARRAY("ZIR")=$$ORDER(HLDA,.IEN)
. F IEN=IEN:0 S IEN=$O(^HL(772,HLDA,"IN",IEN)) Q:'IEN!($E($G(^(IEN,0)),1,3)="ZMT") D
. . S DEP=DEP+1
. . S ARRAY(DEP,"ZDP")=$$CLEAR($P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
. . S ARRAY(DEP,"ZIC")=$$ORDER(HLDA,.IEN)
. . S ARRAY(DEP,"ZIR")=$$ORDER(HLDA,.IEN)
. . I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)'="^^" S SPOUSE=DEP
. . I $P(ARRAY(DEP,"ZDP"),HLFS,6)=2,$P(ARRAY(DEP,"ZDP"),HLFS,2,4)="^^" K ARRAY(DEP) S DEP=DEP-1
. . I DEP S $P(ARRAY(DEP,"ZIC"),HLFS,21)=$$TOTAL(ARRAY(DEP,"ZIC"),ARRAY(DEP,"ZIR"),ARRAY(DEP,"ZDP"))
. S ARRAY("ZMT")=$$CLEAR($P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
. S ERROR=$$CHECK()
Q ERROR
;
;
CHECK() ; check validity of transmission data
;
; Output: error message (first one found)
;
N ERROR,IEN
S ERROR=$$ZIC^IVMUCHK2(ARRAY("ZIC"))
I ERROR']"" S ERROR=$$ZIR^IVMUCHK1(ARRAY("ZIR"))
I ERROR']"" S ERROR=$$ZMT^IVMUCHK4(ARRAY("ZMT"))
I ERROR']"" F IEN=0:0 S IEN=$O(ARRAY(IEN)) Q:'IEN D I ERROR]"" G CHECKQ ; check dependent segments
. S ERROR=$$ZDP^IVMUCHK3(ARRAY(IEN,"ZDP"),IEN)
. I ERROR']"" S ERROR=$$ZIC^IVMUCHK2(ARRAY(IEN,"ZIC"),IEN)
. I ERROR']"" S ERROR=$$ZIR^IVMUCHK1(ARRAY(IEN,"ZIR"),IEN)
CHECKQ Q $G(ERROR)
;
;
ORDER(HLDA,IEN) ; get next node
S IEN=$O(^HL(772,HLDA,"IN",IEN))
Q $$CLEAR($P($G(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
;
;
CLEAR(NODE) ; convert HLQ to null
N I
F I=1:1:25 I $P(NODE,HLFS,I)=HLQ S $P(NODE,HLFS,I)=""
Q NODE
;
;
TOTAL(STRING,INCR,DEP) ; append total on the end
N I,D,N,INC,DEB,NET S (INC,DEB,NET)=""
INC ; income
I $D(INCR),$P($G(DEP),HLFS,6)'=2,'$P(INCR,HLFS,9) S INC=0 G DEBT
F I=3:1:12 S INC=$G(INC)+$P(STRING,HLFS,I)
DEBT ; debts
F I=13:1:15 S DEB=$G(DEB)+$P(STRING,HLFS,I)
NET ; net worth
F I=16:1:19 I $P(STRING,HLFS,I)]"" S NET=$G(NET)+$P(STRING,HLFS,I)
I NET]"" S NET=NET-$P(STRING,HLFS,20)
Q INC_HLFS_DEB_HLFS_NET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMUCHK 3049 printed Nov 22, 2024@17:12:51 Page 2
IVMUCHK ;ALB/MLI - Filter routine to validate MT transmission before filing ; August 31,1994
+1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine will perform edit checks to validate the means test data
+5 ; before it is uploaded into the MAS Means Test files. Any errors will
+6 ; be recorded and will be sent automatically to the IVM Center for
+7 ; processing.
+8 ;
+9 ; called from IVMUM1 before upload routine is invoked
+10 ;
+11 ; input:
+12 ; HLDA as IEN of the HL7 file entry
+13 ; HL* - all other HL7 variables expected
+14 ;
+15 ; output:
+16 ; IVMMTERR as error condition found (free text)
+17 ;
EN() ; entry point to create temp array and begin filter checks
+1 ;
+2 ;
+3 ;
+4 NEW ARRAY,DEP,ERROR,I,IEN,STRING,TYPE,X
+5 SET ERROR=""
+6 FOR IEN=1:0
SET IEN=$ORDER(^HL(772,HLDA,"IN",IEN))
if 'IEN!(ERROR]"")
QUIT
IF $EXTRACT($GET(^(IEN,0)),1,3)="PID"
Begin DoDot:1
+7 KILL ARRAY
SET (DEP,SPOUSE)=0
+8 ; pid segment
SET ARRAY("PID")=$PIECE($GET(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999)
+9 SET ARRAY("ZIC")=$$ORDER(HLDA,.IEN)
SET $PIECE(ARRAY("ZIC"),HLFS,21)=$$TOTAL(ARRAY("ZIC"))
+10 SET ARRAY("ZIR")=$$ORDER(HLDA,.IEN)
+11 FOR IEN=IEN:0
SET IEN=$ORDER(^HL(772,HLDA,"IN",IEN))
if 'IEN!($EXTRACT($GET(^(IEN,0)),1,3)="ZMT")
QUIT
Begin DoDot:2
+12 SET DEP=DEP+1
+13 SET ARRAY(DEP,"ZDP")=$$CLEAR($PIECE($GET(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
+14 SET ARRAY(DEP,"ZIC")=$$ORDER(HLDA,.IEN)
+15 SET ARRAY(DEP,"ZIR")=$$ORDER(HLDA,.IEN)
+16 IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,6)=2
IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,2,4)'="^^"
SET SPOUSE=DEP
+17 IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,6)=2
IF $PIECE(ARRAY(DEP,"ZDP"),HLFS,2,4)="^^"
KILL ARRAY(DEP)
SET DEP=DEP-1
+18 IF DEP
SET $PIECE(ARRAY(DEP,"ZIC"),HLFS,21)=$$TOTAL(ARRAY(DEP,"ZIC"),ARRAY(DEP,"ZIR"),ARRAY(DEP,"ZDP"))
End DoDot:2
+19 SET ARRAY("ZMT")=$$CLEAR($PIECE($GET(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
+20 SET ERROR=$$CHECK()
End DoDot:1
+21 QUIT ERROR
+22 ;
+23 ;
CHECK() ; check validity of transmission data
+1 ;
+2 ; Output: error message (first one found)
+3 ;
+4 NEW ERROR,IEN
+5 SET ERROR=$$ZIC^IVMUCHK2(ARRAY("ZIC"))
+6 IF ERROR']""
SET ERROR=$$ZIR^IVMUCHK1(ARRAY("ZIR"))
+7 IF ERROR']""
SET ERROR=$$ZMT^IVMUCHK4(ARRAY("ZMT"))
+8 ; check dependent segments
IF ERROR']""
FOR IEN=0:0
SET IEN=$ORDER(ARRAY(IEN))
if 'IEN
QUIT
Begin DoDot:1
+9 SET ERROR=$$ZDP^IVMUCHK3(ARRAY(IEN,"ZDP"),IEN)
+10 IF ERROR']""
SET ERROR=$$ZIC^IVMUCHK2(ARRAY(IEN,"ZIC"),IEN)
+11 IF ERROR']""
SET ERROR=$$ZIR^IVMUCHK1(ARRAY(IEN,"ZIR"),IEN)
End DoDot:1
IF ERROR]""
GOTO CHECKQ
CHECKQ QUIT $GET(ERROR)
+1 ;
+2 ;
ORDER(HLDA,IEN) ; get next node
+1 SET IEN=$ORDER(^HL(772,HLDA,"IN",IEN))
+2 QUIT $$CLEAR($PIECE($GET(^HL(772,HLDA,"IN",IEN,0)),HLFS,2,999))
+3 ;
+4 ;
CLEAR(NODE) ; convert HLQ to null
+1 NEW I
+2 FOR I=1:1:25
IF $PIECE(NODE,HLFS,I)=HLQ
SET $PIECE(NODE,HLFS,I)=""
+3 QUIT NODE
+4 ;
+5 ;
TOTAL(STRING,INCR,DEP) ; append total on the end
+1 NEW I,D,N,INC,DEB,NET
SET (INC,DEB,NET)=""
INC ; income
+1 IF $DATA(INCR)
IF $PIECE($GET(DEP),HLFS,6)'=2
IF '$PIECE(INCR,HLFS,9)
SET INC=0
GOTO DEBT
+2 FOR I=3:1:12
SET INC=$GET(INC)+$PIECE(STRING,HLFS,I)
DEBT ; debts
+1 FOR I=13:1:15
SET DEB=$GET(DEB)+$PIECE(STRING,HLFS,I)
NET ; net worth
+1 FOR I=16:1:19
IF $PIECE(STRING,HLFS,I)]""
SET NET=$GET(NET)+$PIECE(STRING,HLFS,I)
+2 IF NET]""
SET NET=NET-$PIECE(STRING,HLFS,20)
+3 QUIT INC_HLFS_DEB_HLFS_NET
