136 lines
5.3 KiB
Mathematica
136 lines
5.3 KiB
Mathematica
IVMCMC ;ALB/SEK,BRM,GN - CHECK INCOME TEST TRANSMISSION SEGMENTS ; 9/17/03 12:54pm
|
|
;;2.0;INCOME VERIFICATION MATCH;**17,34,49,51,90**;21-OCT-94
|
|
;
|
|
;IVM*2*90 - stop upload of LTC type 4 test when staus code not valid
|
|
;
|
|
EN ; Check segment structure of Income Test (Z10) transmission.
|
|
; Variable input:
|
|
; IVMDA -- pointer to an incoming message line in file #772
|
|
; IVMORF -- [optional]: set to 1 if Z10 is an ORF message
|
|
; IVMSEG -- the MSH segment string
|
|
;
|
|
; plus the usual HL7 variables: HLDA, HLFS, HLQ, HLECH
|
|
;
|
|
; Variable output:
|
|
; DFN -- pointer to the patient in file #2
|
|
; DGLY -- Income Year
|
|
; IVMFLGC -- Number of Dependent Children
|
|
; IVMMCI -- HL7 message control id of query sent to IVM Center
|
|
;
|
|
; and the global array ^TMP($J,"IVMCM" which holds the message.
|
|
;
|
|
N ERRMSG,DOBP,SEXP,X,Y
|
|
;
|
|
; - message control id from MSH segment
|
|
S MSGID=$P(IVMSEG,HLFS,10)
|
|
;
|
|
; - if query response (ORF), do additional edit checks
|
|
I $G(IVMORF) D ADDL I $D(HLERR) G ENQ
|
|
;
|
|
; - check the PID segment and get a match on patient
|
|
D GET("PIDV") I IVMSEG1'="PID" D PROB("Missing PID segment") G ENQ
|
|
S DOBP=$P(IVMSEG,HLFS,8),SEXP=$P(IVMSEG,HLFS,9)
|
|
I SEXP'="F"&(SEXP'="M") D PROB("Incorrect value for Sex") G ENQ
|
|
S X=$$FMDATE^HLFNC(DOBP),%DT=X D ^%DT I Y<0 D PROB("Invalid Date of Birth") G ENQ
|
|
S DFN=$$LOOKUP^IVMUFNC($P(IVMSEG,HLFS,20),Y,SEXP,.ERRMSG)
|
|
I 'DFN D PROB(ERRMSG) G ENQ
|
|
;
|
|
; - check for veteran's ZIC and ZIR segments
|
|
D GET("ZICV") I IVMSEG1'="ZIC" D PROB("Missing veteran's ZIC segment") G ENQ
|
|
S DGLY=$$FMDATE^HLFNC($P(IVMSEG,"^",3)) ; income year
|
|
I 'DGLY D PROB("Missing veteran's Income Year") G ENQ
|
|
D GET("ZIRV") I IVMSEG1'="ZIR" D PROB("Missing veteran's ZIR segment") G ENQ
|
|
;
|
|
; - check for spouse's ZDP, ZIC, ZIR segments
|
|
D GET("ZDPS") I IVMSEG1'="ZDP" D PROB("Missing spouse's ZDP segment") G ENQ
|
|
D GET("ZICS") I IVMSEG1'="ZIC" D PROB("Missing spouse's ZIC segment") G ENQ
|
|
D GET("ZIRS") I IVMSEG1'="ZIR" D PROB("Missing spouse's ZIR segment") G ENQ
|
|
;
|
|
; - check for dependent children's ZDP, ZIC, ZIR segments and ZMT segment
|
|
S IVMFLGC=0
|
|
F IVMNBR=1:1 D I $D(HLERR)!(IVMSEG1="ZMT") Q
|
|
.D GET("ZDPC",IVMNBR) I IVMSEG1'="ZDP",IVMSEG1'="ZMT" D PROB("Missing child's ZDP segment or ZMT segment") Q
|
|
.I IVMSEG1="ZMT" Q
|
|
.I $P(IVMSEG,"^",2)=""!($P(IVMSEG,"^",3)="")!($P(IVMSEG,"^",4)="") D PROB("Missing child data from ZDP segment") Q
|
|
.D GET("ZICC",IVMNBR) I IVMSEG1'="ZIC" D PROB("Missing child's ZIC segment") Q
|
|
.D GET("ZIRC",IVMNBR) I IVMSEG1'="ZIR" D PROB("Missing child's ZIR segment") Q
|
|
.S IVMFLGC=IVMFLGC+1 ; # of children
|
|
;
|
|
I $D(HLERR) G ENQ
|
|
;
|
|
; - check for remaining ZMT and ZBT segments
|
|
D GET("ZMT2") I IVMSEG1'="ZMT" D PROB("Missing Copay Test ZMT segment") G ENQ
|
|
;
|
|
; ** added ZMT4 lines for LTC phase II (IVM*2*49)
|
|
; uncomment after all sites have installed to enable consistency chk
|
|
D GET("ZMT4") I IVMSEG1'="ZMT" D PROB("Missing LTC Test ZMT segment") G ENQ
|
|
;
|
|
; remove next line after all sites have installed
|
|
;D GET("ZMT4") I IVMSEG1'="ZMT" K ^TMP($J,"IVMCM","ZMT4") S IVMDA=IVMDA-1
|
|
;
|
|
D GET("ZBT") I IVMSEG1'="ZBT" D PROB("Missing Beneficiary Travel ZBT segment") G ENQ
|
|
;
|
|
ENQ I IVMSEG1="MSH" S IVMDA=IVMDA-1,HLERR="",IVMTYPE=5
|
|
K IVMSEG1,IVMNBR
|
|
Q
|
|
;
|
|
;
|
|
GET(SEG,NUM) ; Get the next HL7 segment.
|
|
; Formal input:
|
|
; SEG -- String with which to build ^TMP($J,"IVMCM"
|
|
; NUM -- Number to index child dependent strings [optional]
|
|
; Required variable input:
|
|
; HLDA -- Pointer to the incoming message in file #772
|
|
; IVMDA -- Pointer to the next message line within file #772
|
|
S IVMDA=$O(^TMP($J,IVMRTN,+IVMDA)),IVMSEG=$G(^(+IVMDA,0))
|
|
S IVMSEG1=$E(IVMSEG,1,3)
|
|
I $G(SEG)="" G GETQ
|
|
I $G(NUM),IVMSEG1'="ZMT" S ^TMP($J,"IVMCM",SEG,NUM)=$P(IVMSEG,HLFS,2,99) G GETQ
|
|
I IVMSEG1="ZMT",$E(SEG,1,3)'="ZMT" S SEG="ZMT1"
|
|
;
|
|
;IVM*2*90 don't allow upload of LTC with a date & a bad status code
|
|
I SEG="ZMT4",$P(IVMSEG,HLFS,3),$P(IVMSEG,HLFS,4)'=0,$P(IVMSEG,HLFS,4)'=1,$P(IVMSEG,HLFS,4)'="""""" Q
|
|
;
|
|
S ^TMP($J,"IVMCM",SEG)=$P(IVMSEG,HLFS,2,99)
|
|
GETQ Q
|
|
;
|
|
PROB(ERR) ; Process encountered errors.
|
|
; Input: ERR -- Error text
|
|
S HLERR=ERR
|
|
D ACK^IVMPREC
|
|
Q
|
|
;
|
|
ADDL ; Perform additional segment checks for ORF messages.
|
|
;
|
|
N DOB,ERRMSG,IVMMSA,IVMPAT,IVMQRD,IVMQRF,QARRAY,QRYIEN,SEX,SSN
|
|
;
|
|
; edit checks for MSA, QRD, and QRF segments
|
|
D GET("") I IVMSEG1'="MSA" D PROB("Missing required MSA segment") G ADDLQ
|
|
S IVMMCI=$P(IVMSEG,"^",3) ; msg control id of msg being acknowledged
|
|
S IVMMSA=IVMSEG
|
|
; trace reply back to the original query msg
|
|
S QRYIEN=$$FINDMSG^IVMCQ2(IVMMCI)
|
|
I 'QRYIEN D PROB("Query not found") G ADDLQ
|
|
I QRYIEN,'$$GET^IVMCQ2(QRYIEN,.QARRAY) D PROB("Query not found") G ADDLQ
|
|
S DFN=QARRAY("DFN")
|
|
;
|
|
D GET("") I IVMSEG1'="QRD" D PROB("Missing required QRD segment") G ADDLQ
|
|
S IVMQRD=IVMSEG
|
|
S SSN=$P(IVMQRD,HLFS,9)
|
|
;
|
|
D GET("") I IVMSEG1'="QRF" D PROB("Missing required QRF segment") G ADDLQ
|
|
S IVMQRF=IVMSEG
|
|
S DOB=$$FMDATE^HLFNC($P(IVMQRF,HLFS,5))
|
|
S SEX=$P(IVMQRF,HLFS,6)
|
|
;
|
|
;
|
|
; if application reject rec'd from HEC (i.e. No income data on file)
|
|
I $P(IVMMSA,HLFS,2)="AR" D
|
|
.S HLERR=""
|
|
.S IVMTYPE=7 ;type 4 is now used for LTC test (IVM*2*49)
|
|
.; - if patient identifiers rec'd from HEC incorrect,
|
|
.; queue off job to send a new query
|
|
.I $$GETPAT^IVMUFNC(DFN,.IVMPAT),((SSN'=IVMPAT("SSN"))!(DOB'=IVMPAT("DOB"))!(SEX'=IVMPAT("SEX"))) D QRYQUE^IVMCQ2(DFN)
|
|
;
|
|
ADDLQ Q
|