- 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 Mar 13, 2025@21:06:46 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