IVMPTRN5 ;ALB/CPM/GN - NIGHTLY BILLING TRANSMISSION PROCESSING ; 1/15/01 11:21am [12/17/03 3:45pm]
;;2.0;INCOME VERIFICATION MATCH;**1,9,24,34,69,78,96**; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
;IVM*2*96 - break up Z09's by Income year, via new "ATR" xref
;
EN ; This routine performs the nightly compilation and transmission
; of DHCP billing activity for IVM patients to the IVM Center.
;
K ^TMP("IVMPTRN5",$J)
D IVMPT ; get data for IVM patients
D INS^IBAMTV4("^TMP(""IVMPTRN5"",$J)") ; get data for Insurance patients
D UPDATE^IVMPTRN6 ; update file #301.61
D TRNSMT ; post transmissions
D TRNSMT^EASPTRN5 ;If any EDB Z09's to transmit - then send
Q
;
;
IVMPT ; Get claims and patient charges for IVM patients
N DFN,IVMSTART,IVMEND
S DFN=0 F S DFN=$O(^IVM(301.61,"C",DFN)) Q:'DFN D
.S IVMSTART=$$INIT(DFN) S:'IVMSTART IVMEND=0
.I IVMSTART S IVMEND=$$FMADD^XLFDT(IVMSTART,364) S:IVMEND>DT IVMEND=DT
.D ALL^IBAMTV4(DFN,"^TMP(""IVMPTRN5"",$J)",IVMSTART,IVMEND)
Q
;
;
TRNSMT ; Transmit required billing activity.
Q:'$D(^IVM(301.61,"ATR"))
;
N HL,HLDT,HLDT1,HLEID,HLMID,MID,MTIEN,RESULT
S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORU-Z09 SERVER"
S HLEID=$O(^ORD(101,"B",HLEID,0))
D INIT^IVMUFNC(HLEID,.HL) S HLMTN="ORU"
;
S ICYR=0 ;IVM*2*96
F S ICYR=$O(^IVM(301.61,"ATR",ICYR)) Q:'ICYR D
. D BLDZ09(ICYR)
D FILE^IVMPTRN3
K DFN,IVMPID,IVMTDA,IVMMTDT,IVMN,IVMSTOP,IVMEVENT,IVMHZIC,VAFPID,DGREL,DGINC,DGINR,DGDEP
D CLEAN^IVMUFNC
Q
;
BLDZ09(ICYR) ;create the Z09 per DFN
S DFN=0
F S DFN=$O(^IVM(301.61,"ATR",ICYR,DFN)) Q:'DFN D
.I $$WHERETO^EASPTRN1(ICYR,DFN) Q ;Do not send EDB Z09's
.I IVMCT=0,$G(IVMGTOT) D FILE^HLTF
.S HLEVN=HLEVN+1
.;
.; FIND A SLOT FOR EACH BATCH
.I HLEVN#100=1 D
..K HLDT,HLDT1,HLMID,MTIEN
..D CREATE^HLTF(.HLMID,.MTIEN,.HLDT,.HLDT1)
.;
.; SET UP MSH SEGMENT
.S MID=HLMID_"-"_HLEVN
.D MSH^HLFNC2(.HL,MID,.RESULT)
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=RESULT
.;
.; - re-set msg control id into MSH segment
.D MSGID^IVMUFNC4(.IVMCT)
.;
.; - create PID segment
.K IVMPID,VAFPID
.S IVMPID=$$EN^VAFHLPID(DFN,"1,3,5,7,8,19") I $D(VAFPID(1)) S IVMPID(1)=VAFPID(1)
.;I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMPID
.I $D(IVMPID(1)) S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMPID(1)
.;
.; - find the patient's Means Test date and create ZIC segment
.S IVMTDA=$O(^IVM(301.61,"ATR",ICYR,DFN,0))
.S IVMMTDT=$S(IVMTDA:$P($G(^IVM(301.61,IVMTDA,0)),"^",5),1:DT)
.D ALL^DGMTU21(DFN,"V",IVMMTDT,"IPR",+$$LST^DGMTU(DFN,IVMMTDT))
.S IVMHZIC=$$EN^VAFHLZIC(+$G(DGINC("V")),"1,2")
.I '$P(IVMHZIC,"^",3) S $P(IVMHZIC,"^",3)=$$HLDATE^HLFNC($O(^IVM(301.5,"APT",DFN,0)))
.;
.; - find all transactions for the patient and create FT1 segments
.S IVMTDA=0 F S IVMTDA=$O(^IVM(301.61,"ATR",ICYR,DFN,IVMTDA)) Q:'IVMTDA D
..S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$FT1^IVMUFNC3(IVMTDA)
..S IVMN=$G(^IVM(301.61,IVMTDA,0))
..;
..; - if a payment has been made (or if the bill is closed),
..; - but the bill has never been transmitted, re-transmit.
..I ($P(IVMN,"^",9)!($P(IVMN,"^",10))),'$P(IVMN,"^",13) D
...D NOW^%DTC S DA=IVMTDA,DIE="^IVM(301.61,",DR=".13////"_% D ^DIE
...S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$FT1^IVMUFNC3(IVMTDA)
..;
..; - update transmission record
..S IVMSTOP=0
..I $P(IVMN,"^",10)!$P(IVMN,"^",11) S IVMSTOP=1
..I $P(IVMN,"^",4)>1 S IVMSTOP=1
..D NOW^%DTC S DR=".12////0;.13////"_%
..I IVMSTOP S DR=DR_";.14////1"
..S DR=DR_";1.03////"_%_";1.04////"_DUZ
..S DA=IVMTDA,DIE="^IVM(301.61," D ^DIE K DA,DR,DIE
.;
.; - set ZIC segment
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMHZIC
.;
.S IVMEVENT="Z09"
.I HLEVN'<100 D FILE^IVMPTRN3
;
Q
;
;
INIT(DFN) ; Find the initial date for which to return patient charges.
; Input: DFN -- Pointer to the patient in file #2
; Output: Date patient became Cat C, or null (for ins. patients)
;
N IVMDATE,X,Y S IVMDATE=0
I '$G(DFN) G INITQ
S X=0 F S X=$O(^IVM(301.61,"C",DFN,X)) Q:'X S Y=$G(^IVM(301.61,X,0)) I $P(Y,"^",4)>1,$P(Y,"^",5) S IVMDATE=$P(Y,"^",5) Q
I IVMDATE S IVMDATE=$P($$LST^DGMTU(DFN,IVMDATE),"^",2)
INITQ Q IVMDATE
;
;Check DISABLE text in #101 to determine if communications with
; Edb are active or not. Text in this field indicates link is not
; active
;
EDB(HLEID) S HLEID=$O(^ORD(101,"B",HLEID,0))
I 'HLEID Q 0 ;Protocol not defined
I $P(^ORD(101,HLEID,0),"^",3)="" Q 1 ;Edb protocol active
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPTRN5 4798 printed Sep 23, 2025@19:37:48 Page 2
IVMPTRN5 ;ALB/CPM/GN - NIGHTLY BILLING TRANSMISSION PROCESSING ; 1/15/01 11:21am [12/17/03 3:45pm]
+1 ;;2.0;INCOME VERIFICATION MATCH;**1,9,24,34,69,78,96**; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+5 ;IVM*2*96 - break up Z09's by Income year, via new "ATR" xref
+6 ;
EN ; This routine performs the nightly compilation and transmission
+1 ; of DHCP billing activity for IVM patients to the IVM Center.
+2 ;
+3 KILL ^TMP("IVMPTRN5",$JOB)
+4 ; get data for IVM patients
DO IVMPT
+5 ; get data for Insurance patients
DO INS^IBAMTV4("^TMP(""IVMPTRN5"",$J)")
+6 ; update file #301.61
DO UPDATE^IVMPTRN6
+7 ; post transmissions
DO TRNSMT
+8 ;If any EDB Z09's to transmit - then send
DO TRNSMT^EASPTRN5
+9 QUIT
+10 ;
+11 ;
IVMPT ; Get claims and patient charges for IVM patients
+1 NEW DFN,IVMSTART,IVMEND
+2 SET DFN=0
FOR
SET DFN=$ORDER(^IVM(301.61,"C",DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 SET IVMSTART=$$INIT(DFN)
if 'IVMSTART
SET IVMEND=0
+4 IF IVMSTART
SET IVMEND=$$FMADD^XLFDT(IVMSTART,364)
if IVMEND>DT
SET IVMEND=DT
+5 DO ALL^IBAMTV4(DFN,"^TMP(""IVMPTRN5"",$J)",IVMSTART,IVMEND)
End DoDot:1
+6 QUIT
+7 ;
+8 ;
TRNSMT ; Transmit required billing activity.
+1 if '$DATA(^IVM(301.61,"ATR"))
QUIT
+2 ;
+3 NEW HL,HLDT,HLDT1,HLEID,HLMID,MID,MTIEN,RESULT
+4 SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" ORU-Z09 SERVER"
+5 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
+6 DO INIT^IVMUFNC(HLEID,.HL)
SET HLMTN="ORU"
+7 ;
+8 ;IVM*2*96
SET ICYR=0
+9 FOR
SET ICYR=$ORDER(^IVM(301.61,"ATR",ICYR))
if 'ICYR
QUIT
Begin DoDot:1
+10 DO BLDZ09(ICYR)
End DoDot:1
+11 DO FILE^IVMPTRN3
+12 KILL DFN,IVMPID,IVMTDA,IVMMTDT,IVMN,IVMSTOP,IVMEVENT,IVMHZIC,VAFPID,DGREL,DGINC,DGINR,DGDEP
+13 DO CLEAN^IVMUFNC
+14 QUIT
+15 ;
BLDZ09(ICYR) ;create the Z09 per DFN
+1 SET DFN=0
+2 FOR
SET DFN=$ORDER(^IVM(301.61,"ATR",ICYR,DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 ;Do not send EDB Z09's
IF $$WHERETO^EASPTRN1(ICYR,DFN)
QUIT
+4 IF IVMCT=0
IF $GET(IVMGTOT)
DO FILE^HLTF
+5 SET HLEVN=HLEVN+1
+6 ;
+7 ; FIND A SLOT FOR EACH BATCH
+8 IF HLEVN#100=1
Begin DoDot:2
+9 KILL HLDT,HLDT1,HLMID,MTIEN
+10 DO CREATE^HLTF(.HLMID,.MTIEN,.HLDT,.HLDT1)
End DoDot:2
+11 ;
+12 ; SET UP MSH SEGMENT
+13 SET MID=HLMID_"-"_HLEVN
+14 DO MSH^HLFNC2(.HL,MID,.RESULT)
+15 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=RESULT
+16 ;
+17 ; - re-set msg control id into MSH segment
+18 DO MSGID^IVMUFNC4(.IVMCT)
+19 ;
+20 ; - create PID segment
+21 KILL IVMPID,VAFPID
+22 SET IVMPID=$$EN^VAFHLPID(DFN,"1,3,5,7,8,19")
IF $DATA(VAFPID(1))
SET IVMPID(1)=VAFPID(1)
+23 ;I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1
+24 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=IVMPID
+25 IF $DATA(IVMPID(1))
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=IVMPID(1)
+26 ;
+27 ; - find the patient's Means Test date and create ZIC segment
+28 SET IVMTDA=$ORDER(^IVM(301.61,"ATR",ICYR,DFN,0))
+29 SET IVMMTDT=$SELECT(IVMTDA:$PIECE($GET(^IVM(301.61,IVMTDA,0)),"^",5),1:DT)
+30 DO ALL^DGMTU21(DFN,"V",IVMMTDT,"IPR",+$$LST^DGMTU(DFN,IVMMTDT))
+31 SET IVMHZIC=$$EN^VAFHLZIC(+$GET(DGINC("V")),"1,2")
+32 IF '$PIECE(IVMHZIC,"^",3)
SET $PIECE(IVMHZIC,"^",3)=$$HLDATE^HLFNC($ORDER(^IVM(301.5,"APT",DFN,0)))
+33 ;
+34 ; - find all transactions for the patient and create FT1 segments
+35 SET IVMTDA=0
FOR
SET IVMTDA=$ORDER(^IVM(301.61,"ATR",ICYR,DFN,IVMTDA))
if 'IVMTDA
QUIT
Begin DoDot:2
+36 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$FT1^IVMUFNC3(IVMTDA)
+37 SET IVMN=$GET(^IVM(301.61,IVMTDA,0))
+38 ;
+39 ; - if a payment has been made (or if the bill is closed),
+40 ; - but the bill has never been transmitted, re-transmit.
+41 IF ($PIECE(IVMN,"^",9)!($PIECE(IVMN,"^",10)))
IF '$PIECE(IVMN,"^",13)
Begin DoDot:3
+42 DO NOW^%DTC
SET DA=IVMTDA
SET DIE="^IVM(301.61,"
SET DR=".13////"_%
DO ^DIE
+43 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$FT1^IVMUFNC3(IVMTDA)
End DoDot:3
+44 ;
+45 ; - update transmission record
+46 SET IVMSTOP=0
+47 IF $PIECE(IVMN,"^",10)!$PIECE(IVMN,"^",11)
SET IVMSTOP=1
+48 IF $PIECE(IVMN,"^",4)>1
SET IVMSTOP=1
+49 DO NOW^%DTC
SET DR=".12////0;.13////"_%
+50 IF IVMSTOP
SET DR=DR_";.14////1"
+51 SET DR=DR_";1.03////"_%_";1.04////"_DUZ
+52 SET DA=IVMTDA
SET DIE="^IVM(301.61,"
DO ^DIE
KILL DA,DR,DIE
End DoDot:2
+53 ;
+54 ; - set ZIC segment
+55 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=IVMHZIC
+56 ;
+57 SET IVMEVENT="Z09"
+58 IF HLEVN'<100
DO FILE^IVMPTRN3
End DoDot:1
+59 ;
+60 QUIT
+61 ;
+62 ;
INIT(DFN) ; Find the initial date for which to return patient charges.
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; Output: Date patient became Cat C, or null (for ins. patients)
+3 ;
+4 NEW IVMDATE,X,Y
SET IVMDATE=0
+5 IF '$GET(DFN)
GOTO INITQ
+6 SET X=0
FOR
SET X=$ORDER(^IVM(301.61,"C",DFN,X))
if 'X
QUIT
SET Y=$GET(^IVM(301.61,X,0))
IF $PIECE(Y,"^",4)>1
IF $PIECE(Y,"^",5)
SET IVMDATE=$PIECE(Y,"^",5)
QUIT
+7 IF IVMDATE
SET IVMDATE=$PIECE($$LST^DGMTU(DFN,IVMDATE),"^",2)
INITQ QUIT IVMDATE
+1 ;
+2 ;Check DISABLE text in #101 to determine if communications with
+3 ; Edb are active or not. Text in this field indicates link is not
+4 ; active
+5 ;
EDB(HLEID) SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
+1 ;Protocol not defined
IF 'HLEID
QUIT 0
+2 ;Edb protocol active
IF $PIECE(^ORD(101,HLEID,0),"^",3)=""
QUIT 1
+3 QUIT 0
