- 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 Jan 18, 2025@03:02:52 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