| [613] | 1 | IVMPRECZ ;ALB/SEK,RTK - ROUTINE TO PROCESS V1.5 ORF-Z06 INCOMING HL7 MESSAGES ; 01/02/03 10:01am
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**34,64,71**;21-OCT-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | GET ; get HL7 segment from ^HL
|
|---|
| 7 | S IVMDA=$O(^HL(772,HLDA,"IN",+IVMDA)),IVMSEG=$G(^(+IVMDA,0))
|
|---|
| 8 | S IVMSEG1=$E(IVMSEG,1,3)
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | ACK ; - prepare acknowledgment (ACK) message
|
|---|
| 12 | S IVMCT=$G(IVMCT)+1
|
|---|
| 13 | S HLSDT="IVMQ",^TMP("HLS",$J,HLSDT,IVMCT)=HLSDATA(1),IVMCT=IVMCT+1
|
|---|
| 14 | S ^TMP("HLS",$J,HLSDT,IVMCT)="MSA"_HLFS_$S($D(HLERR):"AE",1:"AA")_HLFS_HLMID_$S($D(HLERR):HLFS_HLERR_" - SSN "_$S($G(DFN):$P($$PT^IVMUFNC4(DFN),"^",2),1:"NOT FOUND"),1:"")
|
|---|
| 15 | I $D(HLERR) S HLEVN=HLEVN+1,IVMERROR=1
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | NXTSEG(MSGIEN,CURLINE,SEG) ;
|
|---|
| 19 | ;Description: Returns the next segment
|
|---|
| 20 | ;
|
|---|
| 21 | ;Input:
|
|---|
| 22 | ; MSGIEN - IEN in HL7 MESSAGE TEXT file
|
|---|
| 23 | ; CURLINE - subscript of the current segment
|
|---|
| 24 | ;
|
|---|
| 25 | ;Output:
|
|---|
| 26 | ; SEG - an array with the fields of the segment (pass by reference)
|
|---|
| 27 | ; CURLINE - upone exiting, will be the subscript of the next segment
|
|---|
| 28 | ;
|
|---|
| 29 | S CURLINE=CURLINE+1
|
|---|
| 30 | S SEGMENT=$G(^HL(772,MSGIEN,"IN",CURLINE,0))
|
|---|
| 31 | S SEG("TYPE")=$E(SEGMENT,1,3)
|
|---|
| 32 | ;
|
|---|
| 33 | ; MSH & BHS segs first piece is the field separator, which makes breaking the segment into fields a bit different
|
|---|
| 34 | I (SEG("TYPE")="MSH")!(SEG("TYPE")="BHS") D
|
|---|
| 35 | . S SEG(1)=$E(SEGMENT,4)
|
|---|
| 36 | . F I=2:1:30 S SEG(I)=$P(SEGMENT,HLFS,I)
|
|---|
| 37 | E D
|
|---|
| 38 | . F I=2:1:31 S SEG(I-1)=$P(SEGMENT,HLFS,I)
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | ERRBULL ; build mail message for transmission to IVM mail group notifying site
|
|---|
| 42 | ; of upload error.
|
|---|
| 43 | S IVMPAT=$$PT^IVMUFNC4(DFN)
|
|---|
| 44 | S XMSUB="MT SIGNATURE UPLOAD "_$E($P(IVMPAT,"^"),1)_$P(IVMPAT,"^",3)
|
|---|
| 45 | S IVMTEXT(1)="Unable to upload a MT Signature. A Means Test was not found that"
|
|---|
| 46 | S IVMTEXT(2)="matches the Centralized Anniversary Date (CAD) on file at the HEC."
|
|---|
| 47 | S IVMTEXT(3)=" "
|
|---|
| 48 | S IVMTEXT(4)=" NAME: "_$P(IVMPAT,"^")
|
|---|
| 49 | S IVMTEXT(5)=" ID: "_$P(IVMPAT,"^",2)
|
|---|
| 50 | S IVMTEXT(6)=" ERROR: "_IVMTEXT(6)
|
|---|
| 51 | Q
|
|---|
| 52 | ORF ;entry point for Means Test Signature Z06 msgs.
|
|---|
| 53 | N SEG,EVENT,MSGID
|
|---|
| 54 | S:'$D(HLEVN) HLEVN=0
|
|---|
| 55 | D NXTSEG(HLDA,0,.SEG)
|
|---|
| 56 | Q:(SEG("TYPE")'="MSH") ;wouldn't have reached here if this happened!
|
|---|
| 57 | S EVENT=$P(SEG(9),$E(HLECH),2)
|
|---|
| 58 | I EVENT'="Z06" G ORF^IVMCM
|
|---|
| 59 | I $G(HLFS)="" S HLFS="^"
|
|---|
| 60 | I $G(HLECH)="" S HLECH="~"
|
|---|
| 61 | F IVMDA=0:0 S IVMDA=$O(^HL(772,HLDA,"IN",IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D Q:'IVMDA
|
|---|
| 62 | .K HLERR
|
|---|
| 63 | .S HLMID=$P(IVMSEG,HLFS,10) ; message control id from MSH
|
|---|
| 64 | .S IVMFLGC=0
|
|---|
| 65 | .D GET I IVMSEG1'="PID" D Q
|
|---|
| 66 | ..S HLERR="Missing PID segment" D ACK
|
|---|
| 67 | .S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH))
|
|---|
| 68 | .I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
|
|---|
| 69 | ..S HLERR="Invalid DFN" D ACK
|
|---|
| 70 | .I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) S HLERR="Couldn't match IVMSSN with DHCP SSN" D ACK Q
|
|---|
| 71 | .S IVMDAP=IVMDA ; save IVMDA for veteran PID segment
|
|---|
| 72 | .D GET I IVMSEG1'="ZMT" D Q
|
|---|
| 73 | ..S HLERR="Missing ZMT segment" D ACK
|
|---|
| 74 | .; IVMMTDT - means test date
|
|---|
| 75 | .; DGLY - income year
|
|---|
| 76 | .; if Means Test not in DHCP don't upload IVM Means Test
|
|---|
| 77 | .S IVMMTDT=$$FMDATE^HLFNC($P(IVMSEG,HLFS,3)) ; means test date from ZMT segment
|
|---|
| 78 | .S DGLY=$$LYR^DGMTSCU1(IVMMTDT)
|
|---|
| 79 | .; get means test to be updated
|
|---|
| 80 | .N UPMTS
|
|---|
| 81 | .S MTDATE=-IVMMTDT,IVMMTIEN="",(UPMTS,MTFND)=0
|
|---|
| 82 | .F S IVMMTIEN=$O(^DGMT(408.31,"AID",1,DFN,MTDATE,IVMMTIEN),-1) Q:MTFND!(IVMMTIEN="") D
|
|---|
| 83 | ..; match site completing in case multiple tests for same date
|
|---|
| 84 | ..I $P(IVMSEG,HLFS,23)=$P(^DGMT(408.31,IVMMTIEN,2),HLFS,5) S UPMTS=IVMMTIEN,MTFND=1 Q
|
|---|
| 85 | .S (IVMMT31,DGMTP)=$G(^DGMT(408.31,UPMTS,0)) ; DGMTP is event driver variable
|
|---|
| 86 | .I $P(IVMMT31,"^")'=IVMMTDT D Q
|
|---|
| 87 | ..S Y=IVMMTDT X ^DD("DD")
|
|---|
| 88 | ..S IVMTEXT(6)="Means Test of "_Y_" not found in VistA."
|
|---|
| 89 | ..D ERRBULL,MAIL^IVMUFNC()
|
|---|
| 90 | ..S HLERR="Means test not in VistA" D ACK
|
|---|
| 91 | ..Q
|
|---|
| 92 | .I $P(IVMMT31,"^",23)=2 S Y=IVMMTDT X ^DD("DD") S HLERR="2nd means test sent for "_Y D ACK Q
|
|---|
| 93 | .; do not upload IVM means test if primary means test status is
|
|---|
| 94 | .; 3-no longer required
|
|---|
| 95 | .; or if hardship case
|
|---|
| 96 | .S IVMSTAT=$P(IVMMT31,"^",3)
|
|---|
| 97 | .I IVMSTAT=3 S HLERR="NOT UPLOADED no longer required" D ACK Q
|
|---|
| 98 | .I $P(IVMMT31,"^",20)=1 S HLERR="NOT UPLOADED hardship case" D ACK Q
|
|---|
| 99 | .;get MT signature and date/time edited info, update means test
|
|---|
| 100 | .N DATA
|
|---|
| 101 | .S DATA(.29)=$P(IVMSEG,HLFS,28),DATA(2.02)=$$FMDATE^HLFNC($P(IVMSEG,HLFS,26)) I $D(DATA(.29)) D
|
|---|
| 102 | ..I $$UPD^DGENDBS(408.31,UPMTS,.DATA)
|
|---|
| 103 | .I '$D(HLERR) D ACK
|
|---|
| 104 | .;
|
|---|
| 105 | .; cleanup
|
|---|
| 106 | .K DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,IVMFLG7,IVMFLGC,IVMMT31,IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB,FMDATE,MTDATE
|
|---|
| 107 | .Q
|
|---|
| 108 | Q
|
|---|
