EASPTRN5 ;ALB/CPM/GN - NIGHTLY BILLING TRANSMISSION PROCESSING ; 10/30/01 9:58am [12/17/03 1:09pm]
;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,33,47**; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; For Edb Transmission Only - VAMC-to-Edb
;
;EAS*1*47 - 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.
;
TRNSMT ; Transmit required billing activity.
Q:'$D(^IVM(301.61,"ATR"))
; =============
N HL,HLDT,HLDT1,HLEID,HLMID,MID,MTIEN,RESULT,ICYR
S HLEID="EAS EDB ORU-Z09 SERVER"
S HLEID=$O(^ORD(101,"B",HLEID,0))
D INIT^IVMUFNC(HLEID,.HL) S HLMTN="ORU"
S NUMS=""
F I=1:1:30 S NUMS=NUMS_$S(NUMS'="":",",1:"")_I
S ICYR=0 ;EAS*1*47
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 legacy 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)
.; ==========
.;
.; Setup 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^VAFCPID(DFN,"1,2,3,4,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)
.;
.; - create PD1 segment - Patient CMOR segment <<<<<<<<<<<<<<<<<
.;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLPD1(DFN,"1,2,3,4")
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLPD1(DFN,"1,3")
.;
.; - 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")
.;S IVMHZIC=$$EN^VAFHLZIC(+$G(DGINC("V")),$P(NUMS,",",1,23))
.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^EASUFNC3(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^EASUFNC3(IVMTDA)
..;
..; - update transmission record
..;D:ISITESW'["H"
..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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASPTRN5 4163 printed Sep 23, 2025@19:31:47 Page 2
EASPTRN5 ;ALB/CPM/GN - NIGHTLY BILLING TRANSMISSION PROCESSING ; 10/30/01 9:58am [12/17/03 1:09pm]
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,33,47**; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; For Edb Transmission Only - VAMC-to-Edb
+5 ;
+6 ;EAS*1*47 - break up Z09's by Income year, via new "ATR" xref
+7 ;
EN ; This routine performs the nightly compilation and transmission
+1 ; of DHCP billing activity for IVM patients to the IVM Center.
+2 ;
TRNSMT ; Transmit required billing activity.
+1 if '$DATA(^IVM(301.61,"ATR"))
QUIT
+2 ; =============
+3 NEW HL,HLDT,HLDT1,HLEID,HLMID,MID,MTIEN,RESULT,ICYR
+4 SET HLEID="EAS EDB ORU-Z09 SERVER"
+5 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
+6 DO INIT^IVMUFNC(HLEID,.HL)
SET HLMTN="ORU"
+7 SET NUMS=""
+8 FOR I=1:1:30
SET NUMS=NUMS_$SELECT(NUMS'="":",",1:"")_I
+9 ;EAS*1*47
SET ICYR=0
+10 FOR
SET ICYR=$ORDER(^IVM(301.61,"ATR",ICYR))
if 'ICYR
QUIT
Begin DoDot:1
+11 DO BLDZ09(ICYR)
End DoDot:1
+12 DO FILE^IVMPTRN3
+13 KILL DFN,IVMPID,IVMTDA,IVMMTDT,IVMN,IVMSTOP,IVMEVENT,IVMHZIC,VAFPID,DGREL,DGINC,DGINR,DGDEP
+14 DO CLEAN^IVMUFNC
+15 QUIT
+16 ;
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 legacy 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 ;
+13 ; Setup MSH Segment
+14 SET MID=HLMID_"-"_HLEVN
+15 DO MSH^HLFNC2(.HL,MID,.RESULT)
+16 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=RESULT
+17 ;
+18 ; - re-set msg control id into MSH segment
+19 DO MSGID^IVMUFNC4(.IVMCT)
+20 ;
+21 ; - create PID segment
+22 KILL IVMPID,VAFPID
+23 SET IVMPID=$$EN^VAFCPID(DFN,"1,2,3,4,5,7,8,19")
+24 IF $DATA(VAFPID(1))
SET IVMPID(1)=VAFPID(1)
+25 ;I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1
+26 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=IVMPID
+27 IF $DATA(IVMPID(1))
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=IVMPID(1)
+28 ;
+29 ; - create PD1 segment - Patient CMOR segment <<<<<<<<<<<<<<<<<
+30 ;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLPD1(DFN,"1,2,3,4")
+31 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLPD1(DFN,"1,3")
+32 ;
+33 ; - find the patient's Means Test date and create ZIC segment
+34 SET IVMTDA=$ORDER(^IVM(301.61,"ATR",ICYR,DFN,0))
+35 SET IVMMTDT=$SELECT(IVMTDA:$PIECE($GET(^IVM(301.61,IVMTDA,0)),"^",5),1:DT)
+36 DO ALL^DGMTU21(DFN,"V",IVMMTDT,"IPR",+$$LST^DGMTU(DFN,IVMMTDT))
+37 SET IVMHZIC=$$EN^VAFHLZIC(+$GET(DGINC("V")),"1,2")
+38 ;S IVMHZIC=$$EN^VAFHLZIC(+$G(DGINC("V")),$P(NUMS,",",1,23))
+39 IF '$PIECE(IVMHZIC,"^",3)
SET $PIECE(IVMHZIC,"^",3)=$$HLDATE^HLFNC($ORDER(^IVM(301.5,"APT",DFN,0)))
+40 ;
+41 ; - find all transactions for the patient and create FT1 segments
+42 SET IVMTDA=0
FOR
SET IVMTDA=$ORDER(^IVM(301.61,"ATR",ICYR,DFN,IVMTDA))
if 'IVMTDA
QUIT
Begin DoDot:2
+43 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$FT1^EASUFNC3(IVMTDA)
+44 SET IVMN=$GET(^IVM(301.61,IVMTDA,0))
+45 ;
+46 ; - if a payment has been made (or if the bill is closed),
+47 ; - but the bill has never been transmitted, re-transmit.
+48 IF ($PIECE(IVMN,"^",9)!($PIECE(IVMN,"^",10)))
IF '$PIECE(IVMN,"^",13)
Begin DoDot:3
+49 DO NOW^%DTC
SET DA=IVMTDA
SET DIE="^IVM(301.61,"
SET DR=".13////"_%
DO ^DIE
+50 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$FT1^EASUFNC3(IVMTDA)
End DoDot:3
+51 ;
+52 ; - update transmission record
+53 ;D:ISITESW'["H"
+54 SET IVMSTOP=0
+55 IF $PIECE(IVMN,"^",10)!$PIECE(IVMN,"^",11)
SET IVMSTOP=1
+56 IF $PIECE(IVMN,"^",4)>1
SET IVMSTOP=1
+57 DO NOW^%DTC
SET DR=".12////0;.13////"_%
+58 IF IVMSTOP
SET DR=DR_";.14////1"
+59 SET DR=DR_";1.03////"_%_";1.04////"_DUZ
+60 SET DA=IVMTDA
SET DIE="^IVM(301.61,"
DO ^DIE
KILL DA,DR,DIE
End DoDot:2
+61 ;
+62 ; - set ZIC segment
+63 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=IVMHZIC
+64 ;
+65 SET IVMEVENT="Z09"
+66 IF HLEVN'<100
DO FILE^IVMPTRN3
End DoDot:1
+67 ;
+68 QUIT
+69 ;
+70 ;
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
