EASPREC7 ;ALB/SEK,RTK,GN,MNH,LMD - ROUTINE TO PROCESS INCOMING (Z06 EVENT TYPE) HL7 MESSAGES ;6/16/04 9:28am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,30,35,52,42,86,113**;21-OCT-94;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
;** Warning ** currently only one ZMT seg per Z06 can be processed.
;
;;EAS*1*113 Send Bulletin if BTFI is different than what is on files
; - added DGMTYPT and passed down thru all calls that need.
; o DGMTYPT = 1 (Means Test, MT)
; o DGMTYPT = 2 (RX Copay Test, CT)
;EAS*1*52 call PARSEZMT within tag ZMT to define all ZMT variables
;EAS*1*42 add RX Copay Testing Upload and Delete to this routine.
; - added DGMTYPT and passed down thru all calls that need.
; o DGMTYPT = 1 (Means Test, MT)
; o DGMTYPT = 2 (RX Copay Test, CT)
;
; This routine will process (validate) batch ORU Means Test(event type
; Z06) HL7 messages received from the IVM center. Format of batch:
; BHS
; {MSH
; PID
; ZIC
; ZIR
; {ZDP
; ZIC
; ZIR
; }
; ZMT
; ZIV
; }
; BTS
;
EN ; entry point to validate Means Test messages
;
N DEPFLG,EDB,CANCFLG,CASEFLG,SEGSTR,SEGMENTS,MISSING,ERRFLG,Z06COM
N IVM2,IVM3,IVM7,IVM8,IVM10,IVM12,IVM17,IVM18,IVM20,IVM25,IVM26,IVM32,IVMIY ;Add BT indicator EAS*1*113
N IVM2,IVM3,IVM7,IVM8,IVM10,IVM12,IVM17,IVM18,IVM20,IVM25,IVM26,IVM32,IVMIY ; Add ivm32 BT indicator
N IVMDA,IVMPAT,IVMMTSTS,MTFND,UPMTS,MTDATE,TYPE,EASMTDT,EASZ06,EXPIRED
N IVM5,EASZ06D,DGMTYPT
S SEGSTR="00000000000" ;One byte for each segment in message
S SEGMENTS="BHS,MSH,PID,ZIC,ZIR,ZDP,ZIC,ZIR,ZMT,ZIV,BTS"
S EDB="EDB-EAS"
S Z06COM="Z06 MT via Edb"
S (CASEFLG,DEPFLG,ERRFLG,HLERR,IVMDA,IVMFLGC,MTFND,UPMTS)=0
EN1 F S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA D I $D(HLERR) D ACK^IVMPREC S ERRFLG=1 Q
.K HLERR
.D GET
.D @IVMSEG1 ;process each segment type
Q:ERRFLG ;Error detected do not continue
S MISSING=$F(SEGSTR,0) ;Ensure all required segments
I MISSING D I $D(HLERR) D ACK^IVMPREC,CLEANUP Q
. S TYPE=$S(MISSING=3!(MISSING=4):"Veteran's",MISSING>4&(MISSING<8):"Spouse's",1:"")
. S HLERR="Missing "_TYPE_" "_$P(SEGMENTS,",",(MISSING-1))_" Segment"
D PROCESS
I $D(HLERR) D ACK^IVMPREC
;
; cleanup
CLEANUP K DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,CANCFLG,IVMFLGC,IVMMT31
K IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB,HLERR,CLOSFLG
K IVMZ10,IVMDAV,ZIVSEG,ZMTSEG
Q
;
;Dependent upon type of Z06 sent perform the following;
;IVM Case Status:
; Value of 1 = Create/Update Z06 MT/CT, Close Case & Mark REASON CODE
; as 'Converted'
; Value of 0 = Cancel Z06 MT/CT and Mark REASON CODE as 'Not Convert'
;
; If Z06 MT/CT and IVM Case Status is 1 and Z06 MT/CT doesn't exist then
; Create new Z06 MT/CT (new Z06 MT/CT becomes primary and existing
; MT/CT becomes non-primary)
; Assign REASON CODE of 'Converted' in #301.5
; If Z06 MT/CT already exists then
; If IVM Case Status is 0 Then
; Delete Z06 MT/CT for income year and return old MT/CT to primary
; Change REASON CODE from 'Converted' to 'Not Converted' in #301.5
; If IVM Case Status is 1 Then
; Update MT/CT Z06 and Close/Convert Case
; Else (Z06 MT/CT, IVM Case Status=0 and Z06 MT/CT does not exist)
; Send back 'AE' to Edb indicating MT/CT Z06 not available for
; cancellation
;
PROCESS N DIC,%,%H,%I,IVMDATE
D NOW^%DTC
S IVMDATE=%
I '$D(ZMTSEG) S HLERR="ZMT Segment is Missing" Q
S EASZ06=1,EXPIRED=0
S:DGMTYPT=2 IVMCEB=$P($$RXST^IBARXEU(DFN),"^",2) ;prev RX sts
I $G(IVMMTIEN)="" D ; Find any primary for the same year/test type
. S CURMT=$$LST^DGMTU(DFN,IVMMTDT,DGMTYPT)
. I $E($P(CURMT,U,2),1,3)'=$E(IVMMTDT,1,3) Q ;TMK
. S IVMMTIEN=$P(CURMT,"^",1)
. S IVMMTDT=$P(CURMT,"^",2)
. S IVMMTSTS=$P(CURMT,"^",3)
I $G(IVMMTIEN)]"" D ;dgmtp is event driver variable
. S (IVMMT31,DGMTP)=$G(^DGMT(408.31,IVMMTIEN,0))
;
; EAS*1*113
; Send BT Bulletin if Current Means Test Status does not eqaul Previous Means Test Status
;
; Input:
; DFN = IEN of Patient
N DT,DGCAT,FININD
; DFN = IEN of Patient
; DT = Today's Date
S DT=IVMDATE
; DGCAT = Current Means Test Status
S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1)
; IVMCEB = Previous Means Test Status
; IVM10 = Date/Time Test Completed
S FININD="" I $D(IVMMTIEN) S FININD=$G(^DGMT(408.31,IVMMTIEN,4)) ;financial indicator EAS*1*113
;
I IVM32'=FININD D SET^EASBTBUL(DFN,DT,DGCAT,$G(IVMCEB),$G(IVM10))
; EAS*1*113 Only send when BTFI changes
; Main loop to process the IVM income test just received.
;
; No previous 408.31 test on file
I 'MTFND D Q
. I CASEFLG D ;Case=1 Close/Converted
. . ;change old MT/CT to non-primary
. . I $G(IVMMTIEN)>0 D
. . . S DA=IVMMTIEN,DIE="^DGMT(408.31,",DR="2////0;"
. . . D ^DIE K DA,DIE,DR
. . ;
. . S IVMMTDT=EASMTDT
. . D ^EASUM1 ;Create New Z06 MT/CT
. . I $G(IVMMTDT)="" S IVMMTDT=EASMTDT
. . I $$EXPIRED^EASPTRN1(DFN,$G(IVMMTDT)) D
. . . S EXPIRED=1,IVMZ10="UPLOAD IN PROGRESS"
. . D CLOSE^EASPTRN1(IVMIY,DFN,1,6) ;Close Case/Converted
. ;
. I 'CASEFLG D Q
. . S:DGMTYPT=1 HLERR="Existing Z06 MT not found"
. . S:DGMTYPT=2 HLERR="Existing Z06 CT not found"
;
; Previous 408.31 test on file
I MTFND D
. I 'CASEFLG D ;Case=0 Close/Not Convert
. . ; Check to see if MT/CT Z06 exists prior to trying to delete
. . ; If NOT defined then send an AE back to Edb
. . I 'UPMTS D Q ;Existing Z06 not found
. . . S:DGMTYPT=1 HLERR="Existing Z06 MT not found"
. . . S:DGMTYPT=2 HLERR="Existing Z06 CT not found"
. . I UPMTS D Q
. . . N CURMT,IVMMTI,IVMDFN,DGCAT
. . . S IVMDFN=DFN ;Save off DFN
. . . I $$EXPIRED^EASPTRN1(DFN,$G(IVMMTDT)) D
. . . . S EXPIRED=1,IVMZ10="UPLOAD IN PROGRESS"
. . . S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1),IVM5=""
. . . S EASZ06D=1 ;Set del flag for IB event
. . . D ^EASUM7 ;Delete Z06 MT/CT
. . . S DFN=IVMDFN
. . . I $G(IVMMTDT)="" S IVMMTDT=EASMTDT
. . . D CLOSE^EASPTRN1(IVMIY,DFN,1,7) ;Close Case/Not Converted
. ;
. I CASEFLG D ;Case=1 Close/Converted
. . Q:$G(IVMMTIEN)<1
. . S DA=IVMMTIEN,DIE="^DGMT(408.31,"
. . S DR=".03////^S X=IVM3;.12////^S X=IVM8;.07////^S X=IVM10;"
. . S DR=DR_".09////^S X=IVM25;.11////^S X=IVM7;.18////^S X=IVM12;"
. . S DR=DR_".23////^S X=IVM18;.25////^S X=IVM20;"
. . S DR=DR_"2.02////^S X=IVMDATE;2.03////^S X=IVM26;"
. . S DR=DR_"4////^S X=IVM32" ; *EAS*1*113 BT Financial Indicator
. . D ^DIE K DA,DIE,DR ;Update existing Z06
. . I $G(IVMMTDT)="" S IVMMTDT=EASMTDT
. . I $$EXPIRED^EASPTRN1(DFN,$G(IVMMTDT)) D
. . . S EXPIRED=1,IVMZ10="UPLOAD IN PROGRESS"
. . D CLOSE^EASPTRN1(IVMIY,DFN,1,6) ;Close Case/Converted
. . S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1),IVM5=""
. . D MTBULL^EASUM7,MAIL^IVMUFNC() ;Send Bulletin
Q
;
MSH S (HLMID,MSGID)=$P(IVMSEG,HLFS,10) ;Message control id from MSH
Q
PID S DFN=$P($P(IVMSEG,HLFS,4),$E(HLECH))
I ('DFN!(DFN'=+DFN)!('$D(^DPT(+DFN,0)))) D Q
. S HLERR="Invalid DFN"
I $P(IVMSEG,HLFS,20)'=$P(^DPT(DFN,0),"^",9) D Q
. S HLERR="Couldn't match IVM SSN with DHCP SSN"
S IVMDAP=IVMDA ;Save IVMDA for veteran PID segment
Q
ZIC I 'DEPFLG S IVMDGLY=$P(IVMSEG,"^",3) ;Income year
Q
ZIR Q
ZDP S DEPFLG=1
Q
;Get primary means test
; IVMMTDT - means test date
; DGLY - income year
; If Means Test not in DHCP, don't upload IVM Means Test
;
ZMT N IVMIEN,MTCODE ;EAS*1*42
S IVMDAZ=IVMDA,ZMTSEG=IVMSEG ;ZMT segment ivmda
D PARSEZMT(ZMTSEG) ;Retrieve ZMT Values
;Means test date from ZMT segment
S (EASMTDT,IVMMTDT)=$$FMDATE^HLFNC($P(IVMSEG,HLFS,3))
S DGMTYPT=$G(IVM17) ;int type of test
S:DGMTYPT="" DGMTYPT=1 ;insure type defined
S DGLY=$$LYR^DGMTSCU1(IVMMTDT) ;Get means test to be updated
S MTDATE=-IVMMTDT
S IVMIEN=""
S MTFND=0
F S IVMIEN=$O(^DGMT(408.31,"AID",DGMTYPT,DFN,MTDATE,IVMIEN)) Q:MTFND!(IVMIEN="") D
. S IVMMTIEN=IVMIEN
. ; match to MT Z06 from Edb
. S MTCODE=$P($G(^DGMT(408.31,IVMIEN,0)),"^",3)
. I (MTCODE=6)!(MTCODE=16)!(MTCODE=8) D ;Previous Converted MT/CT?
. . S UPMTS=IVMIEN
. . S MTFND=1
Q
ZIV S IVMDAV=IVMDA,ZIVSEG=IVMSEG
S IVMIY=$P(IVMSEG,HLFS,3)
S IVMIY=$$FMDATE^HLFNC(IVMIY)
I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) D Q
. S HLERR="Invalid Income Year"
I "01"'[$P(IVMSEG,HLFS,9) D Q
. S HLERR="Case Status not 0 or 1"
I $P(IVMSEG,HLFS,9)=1 S CASEFLG=1 ;Close/Convert Case Flag
I $P(IVMSEG,HLFS,9)=0 S CASEFLG=0 ;Delete/Not Converted MT Flag
BHS Q
BTS Q
;
GET ; get HL7 segment from ^TMP
;S IVMDA=$O(^TMP($J,IVMRTN,+IVMDA))
S IVMSEG=$G(^TMP($J,IVMRTN,+IVMDA,0))
S IVMSEG1=$E(IVMSEG,1,3)
S $E(SEGSTR,IVMDA)=1
Q
;
;Parse ZMT Segment for MT Data
;
PARSEZMT(ZSEG) ; PARSE THE SEGMEMT
S IVM2=$$FMDATE^HLFNC($P(ZSEG,"^",3)) ;Means Test Date
S IVM3=$O(^DG(408.32,"C",$P(ZSEG,"^",4),"")) ;Means Test Status
S IVM7=$S($P(ZSEG,"^",8)="Y":1,1:0) ;Agrees To Deductible
S IVM8=$P(ZSEG,"^",9) ;Threshold A
S IVM10=$$FMDATE^HLFNC($P(ZSEG,"^",11)) ;Date/Time Completed
S IVM12=$P(ZSEG,"^",13) ;Number of Dependents
S IVM17=$P(ZSEG,"^",18) ;Type of Test
S IVM18=$P(ZSEG,"^",19) ;Source of Test
S IVM20=$$FMDATE^HLFNC($P(ZSEG,"^",21)) ;IVM Verified MT
S IVM25=$$FMDATE^HLFNC($P(ZSEG,"^",26)) ;D/T Last Changed
S IVM26=$O(^DG(408.32,"C",$P(ZSEG,"^",27),"")) ;Test Determined Status
S IVM32=$P(ZSEG,"^",32) ;EAS*1*113
;S IVM32=$S(IVM32="Y":1,IVM32="N":0,1:IVM32) ;BT Financial Indicator
S IVM32=$S(IVM32["""":"",1:IVM32) ;BT Financial Indicator
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASPREC7 10371 printed Nov 22, 2024@17:05:47 Page 2
EASPREC7 ;ALB/SEK,RTK,GN,MNH,LMD - ROUTINE TO PROCESS INCOMING (Z06 EVENT TYPE) HL7 MESSAGES ;6/16/04 9:28am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,30,35,52,42,86,113**;21-OCT-94;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;** Warning ** currently only one ZMT seg per Z06 can be processed.
+5 ;
+6 ;;EAS*1*113 Send Bulletin if BTFI is different than what is on files
+7 ; - added DGMTYPT and passed down thru all calls that need.
+8 ; o DGMTYPT = 1 (Means Test, MT)
+9 ; o DGMTYPT = 2 (RX Copay Test, CT)
+10 ;EAS*1*52 call PARSEZMT within tag ZMT to define all ZMT variables
+11 ;EAS*1*42 add RX Copay Testing Upload and Delete to this routine.
+12 ; - added DGMTYPT and passed down thru all calls that need.
+13 ; o DGMTYPT = 1 (Means Test, MT)
+14 ; o DGMTYPT = 2 (RX Copay Test, CT)
+15 ;
+16 ; This routine will process (validate) batch ORU Means Test(event type
+17 ; Z06) HL7 messages received from the IVM center. Format of batch:
+18 ; BHS
+19 ; {MSH
+20 ; PID
+21 ; ZIC
+22 ; ZIR
+23 ; {ZDP
+24 ; ZIC
+25 ; ZIR
+26 ; }
+27 ; ZMT
+28 ; ZIV
+29 ; }
+30 ; BTS
+31 ;
EN ; entry point to validate Means Test messages
+1 ;
+2 NEW DEPFLG,EDB,CANCFLG,CASEFLG,SEGSTR,SEGMENTS,MISSING,ERRFLG,Z06COM
+3 ;Add BT indicator EAS*1*113
NEW IVM2,IVM3,IVM7,IVM8,IVM10,IVM12,IVM17,IVM18,IVM20,IVM25,IVM26,IVM32,IVMIY
+4 ; Add ivm32 BT indicator
NEW IVM2,IVM3,IVM7,IVM8,IVM10,IVM12,IVM17,IVM18,IVM20,IVM25,IVM26,IVM32,IVMIY
+5 NEW IVMDA,IVMPAT,IVMMTSTS,MTFND,UPMTS,MTDATE,TYPE,EASMTDT,EASZ06,EXPIRED
+6 NEW IVM5,EASZ06D,DGMTYPT
+7 ;One byte for each segment in message
SET SEGSTR="00000000000"
+8 SET SEGMENTS="BHS,MSH,PID,ZIC,ZIR,ZDP,ZIC,ZIR,ZMT,ZIV,BTS"
+9 SET EDB="EDB-EAS"
+10 SET Z06COM="Z06 MT via Edb"
+11 SET (CASEFLG,DEPFLG,ERRFLG,HLERR,IVMDA,IVMFLGC,MTFND,UPMTS)=0
EN1 FOR
SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
if 'IVMDA
QUIT
Begin DoDot:1
+1 KILL HLERR
+2 DO GET
+3 ;process each segment type
DO @IVMSEG1
End DoDot:1
IF $DATA(HLERR)
DO ACK^IVMPREC
SET ERRFLG=1
QUIT
+4 ;Error detected do not continue
if ERRFLG
QUIT
+5 ;Ensure all required segments
SET MISSING=$FIND(SEGSTR,0)
+6 IF MISSING
Begin DoDot:1
+7 SET TYPE=$SELECT(MISSING=3!(MISSING=4):"Veteran's",MISSING>4&(MISSING<8):"Spouse's",1:"")
+8 SET HLERR="Missing "_TYPE_" "_$PIECE(SEGMENTS,",",(MISSING-1))_" Segment"
End DoDot:1
IF $DATA(HLERR)
DO ACK^IVMPREC
DO CLEANUP
QUIT
+9 DO PROCESS
+10 IF $DATA(HLERR)
DO ACK^IVMPREC
+11 ;
+12 ; cleanup
CLEANUP KILL DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,CANCFLG,IVMFLGC,IVMMT31
+1 KILL IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB,HLERR,CLOSFLG
+2 KILL IVMZ10,IVMDAV,ZIVSEG,ZMTSEG
+3 QUIT
+4 ;
+5 ;Dependent upon type of Z06 sent perform the following;
+6 ;IVM Case Status:
+7 ; Value of 1 = Create/Update Z06 MT/CT, Close Case & Mark REASON CODE
+8 ; as 'Converted'
+9 ; Value of 0 = Cancel Z06 MT/CT and Mark REASON CODE as 'Not Convert'
+10 ;
+11 ; If Z06 MT/CT and IVM Case Status is 1 and Z06 MT/CT doesn't exist then
+12 ; Create new Z06 MT/CT (new Z06 MT/CT becomes primary and existing
+13 ; MT/CT becomes non-primary)
+14 ; Assign REASON CODE of 'Converted' in #301.5
+15 ; If Z06 MT/CT already exists then
+16 ; If IVM Case Status is 0 Then
+17 ; Delete Z06 MT/CT for income year and return old MT/CT to primary
+18 ; Change REASON CODE from 'Converted' to 'Not Converted' in #301.5
+19 ; If IVM Case Status is 1 Then
+20 ; Update MT/CT Z06 and Close/Convert Case
+21 ; Else (Z06 MT/CT, IVM Case Status=0 and Z06 MT/CT does not exist)
+22 ; Send back 'AE' to Edb indicating MT/CT Z06 not available for
+23 ; cancellation
+24 ;
PROCESS NEW DIC,%,%H,%I,IVMDATE
+1 DO NOW^%DTC
+2 SET IVMDATE=%
+3 IF '$DATA(ZMTSEG)
SET HLERR="ZMT Segment is Missing"
QUIT
+4 SET EASZ06=1
SET EXPIRED=0
+5 ;prev RX sts
if DGMTYPT=2
SET IVMCEB=$PIECE($$RXST^IBARXEU(DFN),"^",2)
+6 ; Find any primary for the same year/test type
IF $GET(IVMMTIEN)=""
Begin DoDot:1
+7 SET CURMT=$$LST^DGMTU(DFN,IVMMTDT,DGMTYPT)
+8 ;TMK
IF $EXTRACT($PIECE(CURMT,U,2),1,3)'=$EXTRACT(IVMMTDT,1,3)
QUIT
+9 SET IVMMTIEN=$PIECE(CURMT,"^",1)
+10 SET IVMMTDT=$PIECE(CURMT,"^",2)
+11 SET IVMMTSTS=$PIECE(CURMT,"^",3)
End DoDot:1
+12 ;dgmtp is event driver variable
IF $GET(IVMMTIEN)]""
Begin DoDot:1
+13 SET (IVMMT31,DGMTP)=$GET(^DGMT(408.31,IVMMTIEN,0))
End DoDot:1
+14 ;
+15 ; EAS*1*113
+16 ; Send BT Bulletin if Current Means Test Status does not eqaul Previous Means Test Status
+17 ;
+18 ; Input:
+19 ; DFN = IEN of Patient
+20 NEW DT,DGCAT,FININD
+21 ; DFN = IEN of Patient
+22 ; DT = Today's Date
+23 SET DT=IVMDATE
+24 ; DGCAT = Current Means Test Status
+25 SET DGCAT=$PIECE($GET(^DG(408.32,IVM3,0)),"^",1)
+26 ; IVMCEB = Previous Means Test Status
+27 ; IVM10 = Date/Time Test Completed
+28 ;financial indicator EAS*1*113
SET FININD=""
IF $DATA(IVMMTIEN)
SET FININD=$GET(^DGMT(408.31,IVMMTIEN,4))
+29 ;
+30 IF IVM32'=FININD
DO SET^EASBTBUL(DFN,DT,DGCAT,$GET(IVMCEB),$GET(IVM10))
+31 ; EAS*1*113 Only send when BTFI changes
+32 ; Main loop to process the IVM income test just received.
+33 ;
+34 ; No previous 408.31 test on file
+35 IF 'MTFND
Begin DoDot:1
+36 ;Case=1 Close/Converted
IF CASEFLG
Begin DoDot:2
+37 ;change old MT/CT to non-primary
+38 IF $GET(IVMMTIEN)>0
Begin DoDot:3
+39 SET DA=IVMMTIEN
SET DIE="^DGMT(408.31,"
SET DR="2////0;"
+40 DO ^DIE
KILL DA,DIE,DR
End DoDot:3
+41 ;
+42 SET IVMMTDT=EASMTDT
+43 ;Create New Z06 MT/CT
DO ^EASUM1
+44 IF $GET(IVMMTDT)=""
SET IVMMTDT=EASMTDT
+45 IF $$EXPIRED^EASPTRN1(DFN,$GET(IVMMTDT))
Begin DoDot:3
+46 SET EXPIRED=1
SET IVMZ10="UPLOAD IN PROGRESS"
End DoDot:3
+47 ;Close Case/Converted
DO CLOSE^EASPTRN1(IVMIY,DFN,1,6)
End DoDot:2
+48 ;
+49 IF 'CASEFLG
Begin DoDot:2
+50 if DGMTYPT=1
SET HLERR="Existing Z06 MT not found"
+51 if DGMTYPT=2
SET HLERR="Existing Z06 CT not found"
End DoDot:2
QUIT
End DoDot:1
QUIT
+52 ;
+53 ; Previous 408.31 test on file
+54 IF MTFND
Begin DoDot:1
+55 ;Case=0 Close/Not Convert
IF 'CASEFLG
Begin DoDot:2
+56 ; Check to see if MT/CT Z06 exists prior to trying to delete
+57 ; If NOT defined then send an AE back to Edb
+58 ;Existing Z06 not found
IF 'UPMTS
Begin DoDot:3
+59 if DGMTYPT=1
SET HLERR="Existing Z06 MT not found"
+60 if DGMTYPT=2
SET HLERR="Existing Z06 CT not found"
End DoDot:3
QUIT
+61 IF UPMTS
Begin DoDot:3
+62 NEW CURMT,IVMMTI,IVMDFN,DGCAT
+63 ;Save off DFN
SET IVMDFN=DFN
+64 IF $$EXPIRED^EASPTRN1(DFN,$GET(IVMMTDT))
Begin DoDot:4
+65 SET EXPIRED=1
SET IVMZ10="UPLOAD IN PROGRESS"
End DoDot:4
+66 SET DGCAT=$PIECE($GET(^DG(408.32,IVM3,0)),"^",1)
SET IVM5=""
+67 ;Set del flag for IB event
SET EASZ06D=1
+68 ;Delete Z06 MT/CT
DO ^EASUM7
+69 SET DFN=IVMDFN
+70 IF $GET(IVMMTDT)=""
SET IVMMTDT=EASMTDT
+71 ;Close Case/Not Converted
DO CLOSE^EASPTRN1(IVMIY,DFN,1,7)
End DoDot:3
QUIT
End DoDot:2
+72 ;
+73 ;Case=1 Close/Converted
IF CASEFLG
Begin DoDot:2
+74 if $GET(IVMMTIEN)<1
QUIT
+75 SET DA=IVMMTIEN
SET DIE="^DGMT(408.31,"
+76 SET DR=".03////^S X=IVM3;.12////^S X=IVM8;.07////^S X=IVM10;"
+77 SET DR=DR_".09////^S X=IVM25;.11////^S X=IVM7;.18////^S X=IVM12;"
+78 SET DR=DR_".23////^S X=IVM18;.25////^S X=IVM20;"
+79 SET DR=DR_"2.02////^S X=IVMDATE;2.03////^S X=IVM26;"
+80 ; *EAS*1*113 BT Financial Indicator
SET DR=DR_"4////^S X=IVM32"
+81 ;Update existing Z06
DO ^DIE
KILL DA,DIE,DR
+82 IF $GET(IVMMTDT)=""
SET IVMMTDT=EASMTDT
+83 IF $$EXPIRED^EASPTRN1(DFN,$GET(IVMMTDT))
Begin DoDot:3
+84 SET EXPIRED=1
SET IVMZ10="UPLOAD IN PROGRESS"
End DoDot:3
+85 ;Close Case/Converted
DO CLOSE^EASPTRN1(IVMIY,DFN,1,6)
+86 SET DGCAT=$PIECE($GET(^DG(408.32,IVM3,0)),"^",1)
SET IVM5=""
+87 ;Send Bulletin
DO MTBULL^EASUM7
DO MAIL^IVMUFNC()
End DoDot:2
End DoDot:1
+88 QUIT
+89 ;
MSH ;Message control id from MSH
SET (HLMID,MSGID)=$PIECE(IVMSEG,HLFS,10)
+1 QUIT
PID SET DFN=$PIECE($PIECE(IVMSEG,HLFS,4),$EXTRACT(HLECH))
+1 IF ('DFN!(DFN'=+DFN)!('$DATA(^DPT(+DFN,0))))
Begin DoDot:1
+2 SET HLERR="Invalid DFN"
End DoDot:1
QUIT
+3 IF $PIECE(IVMSEG,HLFS,20)'=$PIECE(^DPT(DFN,0),"^",9)
Begin DoDot:1
+4 SET HLERR="Couldn't match IVM SSN with DHCP SSN"
End DoDot:1
QUIT
+5 ;Save IVMDA for veteran PID segment
SET IVMDAP=IVMDA
+6 QUIT
ZIC ;Income year
IF 'DEPFLG
SET IVMDGLY=$PIECE(IVMSEG,"^",3)
+1 QUIT
ZIR QUIT
ZDP SET DEPFLG=1
+1 QUIT
+2 ;Get primary means test
+3 ; IVMMTDT - means test date
+4 ; DGLY - income year
+5 ; If Means Test not in DHCP, don't upload IVM Means Test
+6 ;
ZMT ;EAS*1*42
NEW IVMIEN,MTCODE
+1 ;ZMT segment ivmda
SET IVMDAZ=IVMDA
SET ZMTSEG=IVMSEG
+2 ;Retrieve ZMT Values
DO PARSEZMT(ZMTSEG)
+3 ;Means test date from ZMT segment
+4 SET (EASMTDT,IVMMTDT)=$$FMDATE^HLFNC($PIECE(IVMSEG,HLFS,3))
+5 ;int type of test
SET DGMTYPT=$GET(IVM17)
+6 ;insure type defined
if DGMTYPT=""
SET DGMTYPT=1
+7 ;Get means test to be updated
SET DGLY=$$LYR^DGMTSCU1(IVMMTDT)
+8 SET MTDATE=-IVMMTDT
+9 SET IVMIEN=""
+10 SET MTFND=0
+11 FOR
SET IVMIEN=$ORDER(^DGMT(408.31,"AID",DGMTYPT,DFN,MTDATE,IVMIEN))
if MTFND!(IVMIEN="")
QUIT
Begin DoDot:1
+12 SET IVMMTIEN=IVMIEN
+13 ; match to MT Z06 from Edb
+14 SET MTCODE=$PIECE($GET(^DGMT(408.31,IVMIEN,0)),"^",3)
+15 ;Previous Converted MT/CT?
IF (MTCODE=6)!(MTCODE=16)!(MTCODE=8)
Begin DoDot:2
+16 SET UPMTS=IVMIEN
+17 SET MTFND=1
End DoDot:2
End DoDot:1
+18 QUIT
ZIV SET IVMDAV=IVMDA
SET ZIVSEG=IVMSEG
+1 SET IVMIY=$PIECE(IVMSEG,HLFS,3)
+2 SET IVMIY=$$FMDATE^HLFNC(IVMIY)
+3 IF $EXTRACT(IVMIY,4,7)'="0000"!($EXTRACT(IVMIY,1,3)<292)
Begin DoDot:1
+4 SET HLERR="Invalid Income Year"
End DoDot:1
QUIT
+5 IF "01"'[$PIECE(IVMSEG,HLFS,9)
Begin DoDot:1
+6 SET HLERR="Case Status not 0 or 1"
End DoDot:1
QUIT
+7 ;Close/Convert Case Flag
IF $PIECE(IVMSEG,HLFS,9)=1
SET CASEFLG=1
+8 ;Delete/Not Converted MT Flag
IF $PIECE(IVMSEG,HLFS,9)=0
SET CASEFLG=0
BHS QUIT
BTS QUIT
+1 ;
GET ; get HL7 segment from ^TMP
+1 ;S IVMDA=$O(^TMP($J,IVMRTN,+IVMDA))
+2 SET IVMSEG=$GET(^TMP($JOB,IVMRTN,+IVMDA,0))
+3 SET IVMSEG1=$EXTRACT(IVMSEG,1,3)
+4 SET $EXTRACT(SEGSTR,IVMDA)=1
+5 QUIT
+6 ;
+7 ;Parse ZMT Segment for MT Data
+8 ;
PARSEZMT(ZSEG) ; PARSE THE SEGMEMT
+1 ;Means Test Date
SET IVM2=$$FMDATE^HLFNC($PIECE(ZSEG,"^",3))
+2 ;Means Test Status
SET IVM3=$ORDER(^DG(408.32,"C",$PIECE(ZSEG,"^",4),""))
+3 ;Agrees To Deductible
SET IVM7=$SELECT($PIECE(ZSEG,"^",8)="Y":1,1:0)
+4 ;Threshold A
SET IVM8=$PIECE(ZSEG,"^",9)
+5 ;Date/Time Completed
SET IVM10=$$FMDATE^HLFNC($PIECE(ZSEG,"^",11))
+6 ;Number of Dependents
SET IVM12=$PIECE(ZSEG,"^",13)
+7 ;Type of Test
SET IVM17=$PIECE(ZSEG,"^",18)
+8 ;Source of Test
SET IVM18=$PIECE(ZSEG,"^",19)
+9 ;IVM Verified MT
SET IVM20=$$FMDATE^HLFNC($PIECE(ZSEG,"^",21))
+10 ;D/T Last Changed
SET IVM25=$$FMDATE^HLFNC($PIECE(ZSEG,"^",26))
+11 ;Test Determined Status
SET IVM26=$ORDER(^DG(408.32,"C",$PIECE(ZSEG,"^",27),""))
+12 ;EAS*1*113
SET IVM32=$PIECE(ZSEG,"^",32)
+13 ;S IVM32=$S(IVM32="Y":1,IVM32="N":0,1:IVM32) ;BT Financial Indicator
+14 ;BT Financial Indicator
SET IVM32=$SELECT(IVM32["""":"",1:IVM32)
+15 QUIT
+16 ;
