Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASPREC6

EASPREC6.m

Go to the documentation of this file.
  1. EASPREC6 ;ALB/BD,MNH,LMD - ROUTINE TO PROCESS INCOMING (Z06 EVENT TYPE) HL7 MESSAGES ;6/16/04 9:28am
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**111,113**;21-OCT-94;Build 53
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;** Warning ** currently only one ZMT seg per Z06 can be processed.
  1. ;
  1. ;EAS*1*113 Send Bulletin if BTFI is different than what is on file
  1. ; - added DGMTYPT and passed down thru all calls that need.
  1. ; o DGMTYPT = 1 (Means Test, MT)
  1. ; o DGMTYPT = 2 (RX Copay Test, CT)
  1. ;
  1. ; This routine will process (validate) batch ORU Means Test(event type
  1. ; Z06) HL7 messages received from the IVM center. Format of batch:
  1. ; BHS
  1. ; {MSH
  1. ; PID
  1. ; ZIC
  1. ; ZIR
  1. ; {ZDP
  1. ; ZIC
  1. ; ZIR
  1. ; }
  1. ; ZMT
  1. ; ZIV
  1. ; }
  1. ; BTS
  1. ;
  1. EN ; entry point to validate Means Test messages
  1. ;
  1. N DEPFLG,EDB,CANCFLG,CASEFLG,SEGSTR,SEGMENTS,MISSING,ERRFLG,Z06COM
  1. N IVM2,IVM3,IVM7,IVM8,IVM10,IVM12,IVM17,IVM18,IVM20,IVM25,IVM26,IVM32,IVMIY ;Add BT indicator EAS*1*113
  1. N IVMDA,IVMPAT,IVMMTSTS,MTFND,UPMTS,MTDATE,TYPE,EASMTDT,EASZ06,EXPIRED
  1. N IVM5,EASZ06D,DGMTYPT
  1. S SEGSTR="00000000000" ;One byte for each segment in message
  1. S SEGMENTS="BHS,MSH,PID,PID,ZIC,ZIR,ZDP,ZIC,ZIR,ZMT,ZIV,BTS"
  1. S Z06COM="Z06 MT via Edb"
  1. S (CASEFLG,DEPFLG,ERRFLG,HLERR,IVMDA,IVMFLGC,MTFND,UPMTS)=0
  1. EN1 F S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA D I $D(HLERR) D ACK^IVMPREC S ERRFLG=1 Q
  1. .K HLERR
  1. .D GET
  1. .D @IVMSEG1 ;process each segment type
  1. Q:ERRFLG ;Error detected do not continue
  1. S MISSING=$F(SEGSTR,0) ;Ensure all required segments
  1. I MISSING D I $D(HLERR) D ACK^IVMPREC,CLEANUP Q
  1. . S TYPE=$S(MISSING=3!(MISSING=4):"Veteran's",MISSING>4&(MISSING<8):"Spouse's",1:"")
  1. . S HLERR="Missing "_TYPE_" "_$P(SEGMENTS,",",(MISSING-1))_" Segment"
  1. D PROCESS
  1. I $D(HLERR) D ACK^IVMPREC
  1. ; cleanup
  1. CLEANUP K DGLY,DGMTP,IVMDAP,IVMDAS,IVMDAZ,IVMDGLY,CANCFLG,IVMFLGC,IVMMT31
  1. K IVMMTDT,IVMMTIEN,IVMSEG,IVMSEG1,IVMSTAT,IVMTEXT,XMSUB,HLERR,CLOSFLG
  1. K IVMZ10,IVMDAV,ZIVSEG,ZMTSEG
  1. Q
  1. ;
  1. ;Dependent upon type of Z06 sent perform the following;
  1. ;IVM Case Status:
  1. ; Value of 1 = Create/Update Z06 MT/CT, Close Case & Mark REASON CODE
  1. ; as 'Converted'
  1. ; Value of 0 = Cancel Z06 MT/CT and Mark REASON CODE as 'Not Convert'
  1. ;
  1. ; If Z06 MT/CT and IVM Case Status is 1 and Z06 MT/CT doesn't exist then
  1. ; Create new Z06 MT/CT (new Z06 MT/CT becomes primary and existing
  1. ; MT/CT becomes non-primary)
  1. ; Assign REASON CODE of 'Converted' in #301.5
  1. ; If Z06 MT/CT already exists then
  1. ; If IVM Case Status is 0 Then
  1. ; Delete Z06 MT/CT for income year and return old MT/CT to primary
  1. ; Change REASON CODE from 'Converted' to 'Not Converted' in #301.5
  1. ; If IVM Case Status is 1 Then
  1. ; Update MT/CT Z06 and Close/Convert Case
  1. ; Else (Z06 MT/CT, IVM Case Status=0 and Z06 MT/CT does not exist)
  1. ; Send back 'AE' to Edb indicating MT/CT Z06 not available for
  1. ; cancellation
  1. ;
  1. PROCESS N DIC,%,%H,%I,IVMDATE
  1. D NOW^%DTC
  1. S IVMDATE=%
  1. I '$D(ZMTSEG) S HLERR="ZMT Segment is Missing" Q
  1. S EASZ06=1,EXPIRED=0
  1. S:DGMTYPT=2 IVMCEB=$P($$RXST^IBARXEU(DFN),"^",2) ;prev RX sts
  1. I $G(IVMMTIEN)="" D ; Find any primary for the same year/test type
  1. . S CURMT=$$LST^DGMTU(DFN,IVMMTDT,DGMTYPT)
  1. . I $E($P(CURMT,U,2),1,3)'=$E(IVMMTDT,1,3) Q ;TMK
  1. . S IVMMTIEN=$P(CURMT,"^",1)
  1. . S IVMMTDT=$P(CURMT,"^",2)
  1. . S IVMMTSTS=$P(CURMT,"^",3)
  1. I $G(IVMMTIEN)]"" D ;dgmtp is event driver variable
  1. . S (IVMMT31,DGMTP)=$G(^DGMT(408.31,IVMMTIEN,0))
  1. ;
  1. ; EAS*1*113
  1. ; Send BT Bulletin if BTFI is different than what is on file
  1. ;
  1. ; Input:
  1. ; DFN = IEN of Patient
  1. N DT,DGCAT,FININD
  1. ; DFN = IEN of Patient
  1. ; DT = Today's Date
  1. S DT=IVMDATE
  1. ; DGCAT = Current Means Test Status
  1. S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1)
  1. ; IVMCEB = Previous Means Test Status
  1. ; IVM10 = Date/Time Test Completed
  1. S FININD="" I $D(IVMMTIEN) S FININD=$G(^DGMT(408.31,IVMMTIEN,4)) ;financial indicator EAS*1*113
  1. ;
  1. I IVM32'=FININD D SET^EASBTBUL(DFN,DT,DGCAT,$G(IVMCEB),$G(IVM10))
  1. ;
  1. ;
  1. ; No previous 408.31 test on file
  1. I 'MTFND D Q
  1. . I CASEFLG D ;Case=1 Close/Converted
  1. . . ;change old MT/CT to non-primary
  1. . . I $G(IVMMTIEN)>0 D
  1. . . . S DA=IVMMTIEN,DIE="^DGMT(408.31,",DR="2////0;"
  1. . . . D ^DIE K DA,DIE,DR
  1. . . ;
  1. . . S IVMMTDT=EASMTDT
  1. . . D ^EASUM6 ;Copied from EASUM1 Create New Z06 MT/CT
  1. . . I $G(IVMMTDT)="" S IVMMTDT=EASMTDT
  1. . . I $$EXPIRED^EASPTRN1(DFN,$G(IVMMTDT)) D
  1. . . . S EXPIRED=1,IVMZ10="UPLOAD IN PROGRESS"
  1. . . D CLOSE(IVMIY,DFN,1,6) ;Close Case/Converted
  1. . ;
  1. . I 'CASEFLG D Q
  1. . . S:DGMTYPT=1 HLERR="Existing Z06 MT not found"
  1. . . S:DGMTYPT=2 HLERR="Existing Z06 CT not found"
  1. ;
  1. ; Previous 408.31 test on file
  1. I MTFND D
  1. . I 'CASEFLG D ;Case=0 Close/Not Convert
  1. . . ; Check to see if MT/CT Z06 exists prior to trying to delete
  1. . . ; If NOT defined then send an AE back to Edb
  1. . . I 'UPMTS D Q ;Existing Z06 not found
  1. . . . S:DGMTYPT=1 HLERR="Existing Z06 MT not found"
  1. . . . S:DGMTYPT=2 HLERR="Existing Z06 CT not found"
  1. . . I UPMTS D Q
  1. . . . N CURMT,IVMMTI,IVMDFN,DGCAT
  1. . . . S IVMDFN=DFN ;Save off DFN
  1. . . . I $$EXPIRED^EASPTRN1(DFN,$G(IVMMTDT)) D
  1. . . . . S EXPIRED=1,IVMZ10="UPLOAD IN PROGRESS"
  1. . . . S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1),IVM5=""
  1. . . . S EASZ06D=1 ;Set del flag for IB event
  1. . . . D ^EASUM9 ;Delete Z06 MT/CT
  1. . . . S DFN=IVMDFN
  1. . . . I $G(IVMMTDT)="" S IVMMTDT=EASMTDT
  1. . . . D CLOSE(IVMIY,DFN,1,7) ;Close Case/Not Converted
  1. . ;
  1. . I CASEFLG D ;Case=1 Close/Converted
  1. . . Q:$G(IVMMTIEN)<1
  1. . . S DA=IVMMTIEN,DIE="^DGMT(408.31,"
  1. . . S DR=".03////^S X=IVM3;.12////^S X=IVM8;.07////^S X=IVM10;"
  1. . . S DR=DR_".09////^S X=IVM25;.11////^S X=IVM7;.18////^S X=IVM12;"
  1. . . S DR=DR_".23////^S X=IVM18;.25////^S X=IVM20;"
  1. . . S DR=DR_"2.02////^S X=IVMDATE;2.03////^S X=IVM26;"
  1. . . S DR=DR_"4////^S X=IVM32;" ;BT Financial Indicator EAS*1*113
  1. . . D ^DIE K DA,DIE,DR ;Update existing Z06
  1. . . I $G(IVMMTDT)="" S IVMMTDT=EASMTDT
  1. . . I $$EXPIRED^EASPTRN1(DFN,$G(IVMMTDT)) D
  1. . . . S EXPIRED=1,IVMZ10="UPLOAD IN PROGRESS"
  1. . . D CLOSE(IVMIY,DFN,1,6) ;Close Case/Converted
  1. . . S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1),IVM5=""
  1. . . D MTBULL^EASUM9,MAIL^IVMUFNC() ;Send Bulletin
  1. Q
  1. ;
  1. MSH S (HLMID,MSGID)=$P(IVMSEG,HLFS,10) ;Message control id from MSH
  1. Q
  1. PID ;Handle wrapped PID segment
  1. N I,IVMPID,PIDSTR,COMP,CNTR,NOPID,TMPARY,PID3ARY,CNTR2
  1. S CNTR=1,NOPID=0,PIDSTR(CNTR)=$P(IVMSEG,"^",2,999)
  1. F D Q:NOPID
  1. .S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)),IVMSEG=$G(^(+IVMDA,0))
  1. .I $E(IVMSEG,1,4)="ZIC^" S NOPID=1,IVMDA=IVMDA-1 Q
  1. .S CNTR=CNTR+1,PIDSTR(CNTR)=IVMSEG
  1. .S SEGSTR=$E(SEGSTR,1,IVMDA-1)_"1"_$E(SEGSTR,IVMDA,$L(SEGSTR)) ;Extend SEGSTR for wrapped PID
  1. D BLDPID^IVMPREC6(.PIDSTR,.IVMPID) ;Create IVMPID subscripted by seq #
  1. ;convert "" to null for PID segment
  1. S CNTR="" F S CNTR=$O(IVMPID(CNTR)) Q:CNTR="" D
  1. .I $O(IVMPID(CNTR,"")) D Q
  1. ..S CNTR2="" F S CNTR2=$O(IVMPID(CNTR,CNTR2)) Q:CNTR2="" D
  1. ...S IVMPID(CNTR,CNTR2)=$$CLEARF^IVMPRECA(IVMPID(CNTR,CNTR2),$E(HLECH))
  1. .I IVMPID(CNTR)=HLQ S IVMPID(CNTR)=""
  1. M TMPARY(3)=IVMPID(3) D PARSPID3^IVMUFNC(.TMPARY,.PID3ARY)
  1. S DFN=$G(PID3ARY("PI")),ICN=$G(PID3ARY("NI"))
  1. K TMPARY,PID3ARY
  1. I '$$MATCH^IVMUFNC(DFN,ICN,"","","I",.ERRMSG) S HLERR=ERRMSG Q
  1. S IVMDAP=IVMDA ;Save IVMDA for veteran PID segment
  1. Q
  1. ZIC I 'DEPFLG S IVMDGLY=$P(IVMSEG,"^",3) ;Income year
  1. Q
  1. ZIR Q
  1. ZDP S DEPFLG=1
  1. Q
  1. ;Get primary means test
  1. ; IVMMTDT - means test date
  1. ; DGLY - income year
  1. ; If Means Test not in DHCP, don't upload IVM Means Test
  1. ;
  1. ZMT N IVMIEN,MTCODE ;EAS*1*42
  1. S IVMDAZ=IVMDA,ZMTSEG=IVMSEG ;ZMT segment ivmda
  1. D PARSEZMT(ZMTSEG) ;Retrieve ZMT Values
  1. ;Means test date from ZMT segment
  1. S (EASMTDT,IVMMTDT)=$$FMDATE^HLFNC($P(IVMSEG,HLFS,3))
  1. S DGMTYPT=$G(IVM17) ;int type of test
  1. S:DGMTYPT="" DGMTYPT=1 ;insure type defined
  1. S DGLY=$$LYR^DGMTSCU1(IVMMTDT) ;Get means test to be updated
  1. S MTDATE=-IVMMTDT
  1. S IVMIEN=""
  1. S MTFND=0
  1. F S IVMIEN=$O(^DGMT(408.31,"AID",DGMTYPT,DFN,MTDATE,IVMIEN)) Q:MTFND!(IVMIEN="") D
  1. . S IVMMTIEN=IVMIEN
  1. . ; match to MT Z06 from Edb
  1. . S MTCODE=$P($G(^DGMT(408.31,IVMIEN,0)),"^",3)
  1. . I (MTCODE=6)!(MTCODE=16)!(MTCODE=8) D ;Previous Converted MT/CT - EAS*1.0*111
  1. . . S UPMTS=IVMIEN
  1. . . S MTFND=1
  1. I IVM7="" S (UPMTS,MTFND)=1 ;- EAS*1.0*111 need override for reversal.
  1. Q
  1. ZIV S IVMDAV=IVMDA,ZIVSEG=IVMSEG
  1. S IVMIY=$P(IVMSEG,HLFS,3)
  1. S IVMIY=$$FMDATE^HLFNC(IVMIY)
  1. I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) D Q
  1. . S HLERR="Invalid Income Year"
  1. I "01"'[$P(IVMSEG,HLFS,9) D Q
  1. . S HLERR="Case Status not 0 or 1"
  1. I $P(IVMSEG,HLFS,9)=1 S CASEFLG=1 ;Close/Convert Case Flag
  1. I $P(IVMSEG,HLFS,9)=0 S CASEFLG=0 ;Delete/Not Converted MT Flag
  1. BHS Q
  1. BTS Q
  1. ;
  1. GET ; get HL7 segment from ^TMP
  1. ;S IVMDA=$O(^TMP($J,IVMRTN,+IVMDA))
  1. S IVMSEG=$G(^TMP($J,IVMRTN,+IVMDA,0))
  1. S IVMSEG1=$E(IVMSEG,1,3)
  1. S $E(SEGSTR,IVMDA)=1
  1. Q
  1. ;
  1. ;Parse ZMT Segment for MT Data
  1. ;
  1. PARSEZMT(ZSEG) ;
  1. N CMPDATE
  1. S IVM2=$$FMDATE^HLFNC($P(ZSEG,"^",3)) ;Means Test Date
  1. S IVM3=$O(^DG(408.32,"C",$P(ZSEG,"^",4),"")) ;Means Test Status
  1. ;S IVM7=$S($P(ZSEG,"^",8)="Y":1,$P(ZSEG,"^",8)=1:1,$P(ZSEG,"^",8)="":"",1:0) ;Agrees To Deductible
  1. S IVM7=$S($P(ZSEG,"^",8)]"Yy":1,$P(ZSEG,"^",8)=1:1,$P(ZSEG,"^",8)="":"",1:0) ;Agrees To Deductible
  1. S IVM8=$P(ZSEG,"^",9) ;Threshold A
  1. S CMPDATE=$P(ZSEG,"^",11) S:$E($G(CMPDATE),9,14)="000000" CMPDATE=$E(CMPDATE,1,8) S:+CMPDATE=0 CMPDATE="" S IVM10=$$FMDATE^HLFNC(CMPDATE) ;Date/Time Completed
  1. S IVM12=$P(ZSEG,"^",13) ;Number of Dependents
  1. S IVM17=$P(ZSEG,"^",18) ;Type of Test
  1. S IVM18=$P(ZSEG,"^",19) ;Source of Test
  1. S IVM20=$$FMDATE^HLFNC($P(ZSEG,"^",21)) ;IVM Verified MT
  1. S IVM25=$$FMDATE^HLFNC($P(ZSEG,"^",26)) ;D/T Last Changed
  1. S IVM26=$O(^DG(408.32,"C",$P(ZSEG,"^",27),"")) ;Test Determined Status
  1. S IVM32=$P(ZSEG,"^",32) ;EAS*1*113
  1. ;S IVM32=$S(IVM32="Y":1,IVM32="N":0,1:IVM32) ;BT Financial Indicator EAS*1*113
  1. S IVM32=$S(IVM32["""":"",1:IVM32) ;BT Financial Indicator
  1. Q
  1. ;
  1. CLOSE(IVMIY,DFN,IVMCS,IVMCR) ; Close IVM case record for a patient
  1. ; Input: DFN -- Pointer to the patient in file #2
  1. ; IVMIY -- Income year of the closed case
  1. ; IVMCS -- Closure source [1=IVM | 2=DHCP]
  1. ; IVMCR -- Pointer to the closure reason in file #301.93
  1. ;
  1. N DA,DIE,DR,X,Y,EVENTS,STATUS,EAEVENT,IVEVENT
  1. I '$G(IVMIY)!'$G(DFN)!'$G(IVMCS)!'$G(IVMCR) G CLOSEQ
  1. S IVMDELMT=1 ; flag indicates deletion
  1. S DA=$O(^IVM(301.5,"APT",+DFN,+IVMIY,0))
  1. I $G(^IVM(301.5,+DA,0))']"" G CLOSEQ
  1. ;
  1. ;don't want closing a case to stop transmission of an enrollment event
  1. S STATUS=1
  1. I ($$STATUS^IVMPLOG(+DA,.EVENTS)=0),EVENTS("ENROLL")=1 S STATUS=0
  1. ;
  1. ; If previous years event make sure Enrollment Event does not get
  1. ; updated, and the IVM Event does
  1. ;
  1. ;S EAEVENT=1,IVEVENT=2
  1. ;I $G(EXPIRED)=1 S EAEVENT=2,STATUS=0,IVEVENT=1
  1. ;I $G(EXPIRED)=0 S EAEVENT=1,STATUS=0
  1. D NOW^%DTC S DR=".03////"_STATUS_";.04////1;1.01////"_IVMCR_";1.02////"_IVMCS_";1.03////"_%_";30.01////2;30.02////2"
  1. S DIE="^IVM(301.5," D ^DIE
  1. CLOSEQ Q
  1. ;