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

IVMPTRN5.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. ;IVM*2*96 - break up Z09's by Income year, via new "ATR" xref
  1. ;
  1. EN ; This routine performs the nightly compilation and transmission
  1. ; of DHCP billing activity for IVM patients to the IVM Center.
  1. ;
  1. K ^TMP("IVMPTRN5",$J)
  1. D IVMPT ; get data for IVM patients
  1. D INS^IBAMTV4("^TMP(""IVMPTRN5"",$J)") ; get data for Insurance patients
  1. D UPDATE^IVMPTRN6 ; update file #301.61
  1. D TRNSMT ; post transmissions
  1. D TRNSMT^EASPTRN5 ;If any EDB Z09's to transmit - then send
  1. Q
  1. ;
  1. ;
  1. IVMPT ; Get claims and patient charges for IVM patients
  1. N DFN,IVMSTART,IVMEND
  1. S DFN=0 F S DFN=$O(^IVM(301.61,"C",DFN)) Q:'DFN D
  1. .S IVMSTART=$$INIT(DFN) S:'IVMSTART IVMEND=0
  1. .I IVMSTART S IVMEND=$$FMADD^XLFDT(IVMSTART,364) S:IVMEND>DT IVMEND=DT
  1. .D ALL^IBAMTV4(DFN,"^TMP(""IVMPTRN5"",$J)",IVMSTART,IVMEND)
  1. Q
  1. ;
  1. ;
  1. TRNSMT ; Transmit required billing activity.
  1. Q:'$D(^IVM(301.61,"ATR"))
  1. ;
  1. N HL,HLDT,HLDT1,HLEID,HLMID,MID,MTIEN,RESULT
  1. S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORU-Z09 SERVER"
  1. S HLEID=$O(^ORD(101,"B",HLEID,0))
  1. D INIT^IVMUFNC(HLEID,.HL) S HLMTN="ORU"
  1. ;
  1. S ICYR=0 ;IVM*2*96
  1. F S ICYR=$O(^IVM(301.61,"ATR",ICYR)) Q:'ICYR D
  1. . D BLDZ09(ICYR)
  1. D FILE^IVMPTRN3
  1. K DFN,IVMPID,IVMTDA,IVMMTDT,IVMN,IVMSTOP,IVMEVENT,IVMHZIC,VAFPID,DGREL,DGINC,DGINR,DGDEP
  1. D CLEAN^IVMUFNC
  1. Q
  1. ;
  1. BLDZ09(ICYR) ;create the Z09 per DFN
  1. S DFN=0
  1. F S DFN=$O(^IVM(301.61,"ATR",ICYR,DFN)) Q:'DFN D
  1. .I $$WHERETO^EASPTRN1(ICYR,DFN) Q ;Do not send EDB Z09's
  1. .I IVMCT=0,$G(IVMGTOT) D FILE^HLTF
  1. .S HLEVN=HLEVN+1
  1. .;
  1. .; FIND A SLOT FOR EACH BATCH
  1. .I HLEVN#100=1 D
  1. ..K HLDT,HLDT1,HLMID,MTIEN
  1. ..D CREATE^HLTF(.HLMID,.MTIEN,.HLDT,.HLDT1)
  1. .;
  1. .; SET UP MSH SEGMENT
  1. .S MID=HLMID_"-"_HLEVN
  1. .D MSH^HLFNC2(.HL,MID,.RESULT)
  1. .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=RESULT
  1. .;
  1. .; - re-set msg control id into MSH segment
  1. .D MSGID^IVMUFNC4(.IVMCT)
  1. .;
  1. .; - create PID segment
  1. .K IVMPID,VAFPID
  1. .S IVMPID=$$EN^VAFHLPID(DFN,"1,3,5,7,8,19") I $D(VAFPID(1)) S IVMPID(1)=VAFPID(1)
  1. .;I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1
  1. .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMPID
  1. .I $D(IVMPID(1)) S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMPID(1)
  1. .;
  1. .; - find the patient's Means Test date and create ZIC segment
  1. .S IVMTDA=$O(^IVM(301.61,"ATR",ICYR,DFN,0))
  1. .S IVMMTDT=$S(IVMTDA:$P($G(^IVM(301.61,IVMTDA,0)),"^",5),1:DT)
  1. .D ALL^DGMTU21(DFN,"V",IVMMTDT,"IPR",+$$LST^DGMTU(DFN,IVMMTDT))
  1. .S IVMHZIC=$$EN^VAFHLZIC(+$G(DGINC("V")),"1,2")
  1. .I '$P(IVMHZIC,"^",3) S $P(IVMHZIC,"^",3)=$$HLDATE^HLFNC($O(^IVM(301.5,"APT",DFN,0)))
  1. .;
  1. .; - find all transactions for the patient and create FT1 segments
  1. .S IVMTDA=0 F S IVMTDA=$O(^IVM(301.61,"ATR",ICYR,DFN,IVMTDA)) Q:'IVMTDA D
  1. ..S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$FT1^IVMUFNC3(IVMTDA)
  1. ..S IVMN=$G(^IVM(301.61,IVMTDA,0))
  1. ..;
  1. ..; - if a payment has been made (or if the bill is closed),
  1. ..; - but the bill has never been transmitted, re-transmit.
  1. ..I ($P(IVMN,"^",9)!($P(IVMN,"^",10))),'$P(IVMN,"^",13) D
  1. ...D NOW^%DTC S DA=IVMTDA,DIE="^IVM(301.61,",DR=".13////"_% D ^DIE
  1. ...S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$FT1^IVMUFNC3(IVMTDA)
  1. ..;
  1. ..; - update transmission record
  1. ..S IVMSTOP=0
  1. ..I $P(IVMN,"^",10)!$P(IVMN,"^",11) S IVMSTOP=1
  1. ..I $P(IVMN,"^",4)>1 S IVMSTOP=1
  1. ..D NOW^%DTC S DR=".12////0;.13////"_%
  1. ..I IVMSTOP S DR=DR_";.14////1"
  1. ..S DR=DR_";1.03////"_%_";1.04////"_DUZ
  1. ..S DA=IVMTDA,DIE="^IVM(301.61," D ^DIE K DA,DR,DIE
  1. .;
  1. .; - set ZIC segment
  1. .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=IVMHZIC
  1. .;
  1. .S IVMEVENT="Z09"
  1. .I HLEVN'<100 D FILE^IVMPTRN3
  1. ;
  1. Q
  1. ;
  1. ;
  1. INIT(DFN) ; Find the initial date for which to return patient charges.
  1. ; Input: DFN -- Pointer to the patient in file #2
  1. ; Output: Date patient became Cat C, or null (for ins. patients)
  1. ;
  1. N IVMDATE,X,Y S IVMDATE=0
  1. I '$G(DFN) G INITQ
  1. 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
  1. I IVMDATE S IVMDATE=$P($$LST^DGMTU(DFN,IVMDATE),"^",2)
  1. INITQ Q IVMDATE
  1. ;
  1. ;Check DISABLE text in #101 to determine if communications with
  1. ; Edb are active or not. Text in this field indicates link is not
  1. ; active
  1. ;
  1. EDB(HLEID) S HLEID=$O(^ORD(101,"B",HLEID,0))
  1. I 'HLEID Q 0 ;Protocol not defined
  1. I $P(^ORD(101,HLEID,0),"^",3)="" Q 1 ;Edb protocol active
  1. Q 0