206 lines
8.7 KiB
Mathematica
206 lines
8.7 KiB
Mathematica
IVMPTRN9 ;ALB/KCL/CN/BRM,TDM,EG - HL7 FULL DATA TRANSMISSION (Z07) BUILDER (CONTINUED) ; 4/10/06 4:36pm
|
|
;;2.0;INCOME VERIFICATION MATCH;**9,11,19,12,21,17,46,50,53,34,49,58,79,99,116,105**; 21-OCT-94;Build 2
|
|
;
|
|
;
|
|
GOTO ; place to break up the routine
|
|
;
|
|
; create (ZIO) Inpatient/Outpatient segment for veteran
|
|
S N101015=$G(^DPT(DFN,1010.15))
|
|
S ZIOSEG="ZIO^1^"_$$EN^IVMUFNC1(DFN,IVMMTDT,.IVMQUERY) ;seq 1-3
|
|
S ZIOSEG=ZIOSEG_"^"_$$LTD^IVMUFNC(DFN,.IVMQUERY) ;seq 4
|
|
S X=$P(N101015,"^",9),$P(ZIOSEG,U,6)=$S(X=0:"N",X=1:"Y",1:HLQ) ;Appt Request
|
|
S X=$P(N101015,"^",11),$P(ZIOSEG,U,7)=$S(X]"":$$HLDATE^HLFNC(X),1:HLQ) ;Appt Request Date
|
|
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=ZIOSEG
|
|
;
|
|
; create (NTE) Notes and Comments segment
|
|
D NTE^IVMUFNC4(DFN,.IVMNTE,IVMMTDT)
|
|
I '$D(IVMNTE) D
|
|
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="NTE^1"
|
|
I $D(IVMNTE) D
|
|
.; - get notes and comments
|
|
.F IVMSUB=0:0 S IVMSUB=$O(IVMNTE(IVMSUB)) Q:'IVMSUB D
|
|
..S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMNTE(IVMSUB)
|
|
;
|
|
; create (IN1) Insurance segment(s) for all active insurance
|
|
K ^TMP("VAFIN1",$J)
|
|
D EN^VAFHLIN1(DFN,"1,4,5,7,8,9,12,13,15,16,17,28,36")
|
|
F IVMSUB=0:0 S IVMSUB=$O(^TMP("VAFIN1",$J,IVMSUB)) Q:'IVMSUB D
|
|
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=^TMP("VAFIN1",$J,+IVMSUB,0)
|
|
;
|
|
;find if the deletion flags were set in the IVM Patient file, and if so, should the deletion indicators be sent?
|
|
F I="RX","MT","HARDSHIP","DATE OF TEST","LTC" S DELETE(I)=""
|
|
S IVMPIEN=$$FIND^IVMPLOG(DFN,($E(IVMMTDT,1,3)-1))
|
|
I IVMPIEN D
|
|
.S IVMPNODE=$G(^IVM(301.5,IVMPIEN,0))
|
|
.I $P(IVMPNODE,"^",8)!$P(IVMPNODE,"^",9)!$P(IVMPNODE,"^",10)!$P(IVMPNODE,"^",11) S DELETE("SET")=1
|
|
.;was the MT deletion flag set, and if so verify that there is no completed MT
|
|
.I $P(IVMPNODE,"^",8),(TESTTYPE'=1)!(TESTCODE="")!("ACGP"'[TESTCODE) S DELETE("DATE OF TEST")=$P(IVMPNODE,"^",8),DELETE("MT")=1
|
|
.;
|
|
.;was the hardship deletion flag set, and if so verify that there is no completed hardship
|
|
.I $P(IVMPNODE,"^",10),'HARDSHIP D
|
|
..S:('DELETE("DATE OF TEST")) DELETE("DATE OF TEST")=$P(IVMPNODE,"^",10)
|
|
..S DELETE("HARDSHIP")=1
|
|
;
|
|
; create (ZMT) Means Test segment
|
|
;
|
|
S SEQS=$S(TESTTYPE=1:"1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,21,22,23,24,25,26,28,29,30",1:"1,17")
|
|
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^IVMCZMT(DFN,SEQS,IVMMTDT,1,1,.DELETE,1)
|
|
;
|
|
; create (ZMT) Rx-Copay Test segment
|
|
I IVMPIEN D
|
|
.;was the RX deletion flag set, and if so verify that there is no completed test
|
|
.I $P(IVMPNODE,"^",9),(TESTTYPE'=2)!(TESTCODE="")!("EM"'[TESTCODE) S DELETE("DATE OF TEST")=$P(IVMPNODE,"^",9),DELETE("RX")=1
|
|
;
|
|
N IVMCPDT,CPTST,LINK,CPDATE
|
|
;should be ok to get the last co-pay test for this year vs. looking from the IVMMTDT backwards
|
|
;as long as the means test date is in the current year
|
|
S CPTST=$$LST^DGMTU(DFN,$E(IVMIY,1,3)+1_1231,2)
|
|
I CPTST D
|
|
. S CPDATE=$P(CPTST,U,2)
|
|
. S LINK=$P($G(^DGMT(408.31,+CPTST,2)),U,6)
|
|
. I TESTTYPE=1,$E(CPDATE,1,3)=$E(IVMMTDT,1,3) D
|
|
. . ;if you have a means test and a linked co-pay test then send both (the means test
|
|
. . ;was already sent from above)
|
|
. . ;if means and copay are not linked, don't send the co-pay test (the means test
|
|
. . ;was already sent from above)
|
|
. . I LINK=+$$LST^DGMTU(DFN,IVMMTDT,1) S TESTTYPE=2,(IVMCPDT,IVMMTDT)=CPDATE
|
|
. . Q
|
|
. Q
|
|
;always send the 2nd ZMT segment
|
|
S SEQS="1,17"
|
|
;can also send a co-pay test if there is no means test (see module GETTYPE)
|
|
I TESTTYPE=2 D
|
|
. S SEQS="1,2,3,4,5,6,7,9,10,12,15,16,17,18,21,22,25,26"
|
|
. Q
|
|
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^IVMCZMT(DFN,SEQS,IVMMTDT,2,2,.DELETE,1)
|
|
;
|
|
; create (ZMT) Long Term Care Copay Exemption Test segment
|
|
I IVMPIEN D
|
|
.; set deletion indicators if LTC test deletion should be transmitted
|
|
.I $P(IVMPNODE,"^",11) S DELETE("LTC")=1 S:('DELETE("DATE OF TEST")) DELETE("DATE OF TEST")=$P(IVMPNODE,"^",11)
|
|
;
|
|
S SEQS="1,2,3,4,5,7,9,10,12,16,17,18,22,25"
|
|
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^IVMCZMT(DFN,SEQS,IVMMTDT,4,4,.DELETE,1)
|
|
;
|
|
;if the deletion flags were set in the IVM Patient file, unset them
|
|
I $G(DELETE("SET")) D
|
|
.N DATA
|
|
.S DATA(.08)="",DATA(.09)="",DATA(.1)="",DATA(.11)=""
|
|
.I $$UPD^DGENDBS(301.5,IVMPIEN,.DATA)
|
|
;
|
|
; create (ZBT) Beneficiary Travel segment based on last BT Claim
|
|
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZBT($$BTCLM^IVMUFNC4(DFN),"1,2,3,4,7")
|
|
;
|
|
; create (ZFE) Fee Basis segment(s)
|
|
D EN^FBHLZFE(DFN,"1,2,3,4,5")
|
|
F IVMSUB=0:0 S IVMSUB=+$O(FBZFE(IVMSUB)) Q:'IVMSUB D
|
|
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(FBZFE(+IVMSUB))
|
|
;
|
|
; create (ZSP) Service Period segment
|
|
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZSP(DFN,1,1)
|
|
;
|
|
; optionally create (OBX) segment for Patient Sensitivity Flag
|
|
K OBXTMP
|
|
S OBXCNT=0,GETCUR=$$FINDSEC^DGENSEC(DFN)
|
|
I GETCUR,$$GET^DGENSEC(GETCUR,.DGSEC) D
|
|
.Q:(DGSEC("LEVEL")'=1)&(DGSEC("LEVEL")'=0)
|
|
.S OBXTMP(2)="CE",OBXTMP(3)="38.1"_$E(HL("ECH"))_"SECURITY LOG"
|
|
.S:DGSEC("LEVEL") OBXTMP(5)="Y"_$E(HL("ECH"))_"YES"_$E(HL("ECH"))_"HL70136"
|
|
.S:'DGSEC("LEVEL") OBXTMP(5)="N"_$E(HL("ECH"))_"NO"_$E(HL("ECH"))_"HL70136"
|
|
.S OBXTMP(11)="R",OBXTMP(14)=DGSEC("DATETIME")
|
|
.S OBXTMP(16)="" I $G(DGSEC("SOURCE"))'="" D
|
|
..S $P(OBXTMP(16),$E(HL("ECH")),14)=$E(HL("ECH"),4)_DGSEC("SOURCE")
|
|
.S IVMCT=IVMCT+1,OBXCNT=OBXCNT+1
|
|
.S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLOBX(.OBXTMP,OBXCNT,"2,3,5,11,14,16")
|
|
.I $G(OBXTMP(16))'="" S $P(^TMP("HLS",$J,IVMCT),"^",17)=$G(OBXTMP(16))
|
|
;
|
|
; create (OBX) segment for NTR
|
|
; CALL PIMS API TO GET NTRARRY OF NTR DATA
|
|
S GETCUR=$$ENRGET^DGNTAPI1(DFN)
|
|
I GETCUR D NTROBX^IVMPTRNA(.DGNTARR)
|
|
I $D(NTROBX) D
|
|
. S IVMCT=IVMCT+1,OBXCNT=OBXCNT+1
|
|
. S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLOBX(.NTROBX,OBXCNT,"2,3,5,11,12,14,15,16,17")
|
|
. I $G(NTROBX(16))'="" S $P(^TMP("HLS",$J,IVMCT),"^",17)=$G(NTROBX(16))
|
|
. K NTROBX
|
|
;
|
|
; create (RF1) segment
|
|
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$RF1^IVMPTRNA(DFN,"SAD")
|
|
F RF1TYP="CAD","CPH","PNO","EAD" D ;Create Optional RF1 Segments
|
|
. S RF1SEG=$$RF1^IVMPTRNA(DFN,RF1TYP) Q:RF1SEG=""
|
|
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=RF1SEG
|
|
;
|
|
Q
|
|
;
|
|
GETTYPE(DFN,IVMMTDT,CODE,HARDSHIP,ACTVIEN) ;
|
|
;Determines the type of test to include in the Z10. HEC wants only the
|
|
;test that they would consider primary,i.e., preference given to a comptleted means test, even if not currently in effect.
|
|
;
|
|
;Input:
|
|
; DFN
|
|
; IVMMTDT -date to be the search for the test
|
|
;Output:
|
|
; Function value - type of test to send in Z10
|
|
; CODE - status code of test (pass by reference)
|
|
; HARDSHIP - hardship indicator (pass by reference)
|
|
; ACTVIEN - ien of test that should have the associated Income Relations (pass by reference)
|
|
;
|
|
N TESTTYPE,MTNODE,RXNODE,NODE0,NODE2
|
|
S TESTTYPE=1
|
|
S (HARDSHIP,CODE,ACTVIEN)=""
|
|
Q:'$G(IVMMTDT) TESTTYPE
|
|
Q:'$G(DFN) TESTTYPE
|
|
;
|
|
S MTNODE=$$LST^DGMTU(DFN,IVMMTDT,1) I $E($P(MTNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S MTNODE=""
|
|
S RXNODE=$$LST^DGMTU(DFN,IVMMTDT,2) I $E($P(RXNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S RXNODE=""
|
|
;
|
|
I MTNODE="" S MTNODE=$$FUT^DGMTU(DFN,"",1) I $E($P(MTNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S MTNODE=""
|
|
I RXNODE="" S RXNODE=$$FUT^DGMTU(DFN,"",2) I $E($P(RXNODE,"^",2),1,3)'=$E(IVMMTDT,1,3) S RXNODE=""
|
|
D
|
|
.;determine which test has the associated income relations
|
|
.;
|
|
.I +MTNODE S CODE=$P(MTNODE,"^",4) I CODE'="",("ACGPR"[CODE) S ACTVIEN=+MTNODE Q
|
|
.I +RXNODE S CODE=$P(RXNODE,"^",4) I CODE'="",("EMI"[CODE) S ACTVIEN=+RXNODE Q
|
|
.I +MTNODE S ACTVIEN=+MTNODE Q
|
|
.I +RXNODE S ACTVIEN=+RXNODE Q
|
|
I ACTVIEN,+MTNODE,+RXNODE D TRANSFER^DGMTU4(DFN,$S((ACTVIEN=+MTNODE):+RXNODE,1:+MTNODE),ACTVIEN)
|
|
;
|
|
;now find the primary test
|
|
I '(+MTNODE) G CHKCOPAY
|
|
S CODE=$P(MTNODE,"^",4)
|
|
S HARDSHIP=$P($G(^DGMT(408.31,+MTNODE,0)),"^",20)
|
|
I (CODE="")!("ACGP"'[CODE) S NODE2=$G(^DGMT(408.31,+MTNODE,2)),CODE=$$GETCODE^DGMTH($P(NODE2,"^",3)) I (CODE="")!("ACGP"'[CODE) G CHKCOPAY
|
|
;
|
|
G QGETTYPE
|
|
;
|
|
CHKCOPAY ;
|
|
I '(+RXNODE) G QGETTYPE
|
|
S CODE=$P(RXNODE,"^",4)
|
|
I (CODE="")!("EM"'[CODE) S NODE2=$G(^DGMT(408.31,+RXNODE,2)),CODE=$$GETCODE^DGMTH($P(NODE2,"^",3)) I (CODE="")!("EM"'[CODE) G QGETTYPE
|
|
S TESTTYPE=2
|
|
;
|
|
QGETTYPE ;
|
|
Q TESTTYPE
|
|
;
|
|
FILTER(DFN) ; address transmission filter
|
|
; Check Bad Address Indicator for a known bad address and
|
|
; Scrutinize the Street Address line 1 field for known bad address
|
|
; strings based on functionality currently in place in HEC Legacy.
|
|
;
|
|
; Input: DFN - ien of the Patient (#2) file
|
|
; Output: 0 - filter passed (ok to transmit address)
|
|
; 1 - filter failed (do not transmit address)
|
|
;
|
|
N VAPA
|
|
Q:'$G(DFN) 1 ;DFN missing
|
|
Q:$$BADADR^DGUTL3(DFN) 1 ;check Bad Address Indicator
|
|
D ADD^VADPT ;get patient address
|
|
; Street Address Line 1 or Zip Code is <null>
|
|
Q:($G(VAPA(1))="")!($P($G(VAPA(11)),"^")="") 1
|
|
; St Addr Line 1 contains 'UNKNOWN', 'HOMELESS', or 'ADDRESS'
|
|
Q:(VAPA(1)["UNKNOWN")!(VAPA(1)["HOMELESS")!(VAPA(1)["ADDRESS") 1
|
|
; The first two characters of the address is equal to '**'
|
|
Q:$E(VAPA(1),1,2)="**" 1
|
|
; passed all address filters - ok to send
|
|
Q 0
|