EASUFNC3 ;ALB/CPM/EJG/GN - BILLING TRANSMISSION UTILITIES ; 13-JUN-94 [12/22/03 10:30am]
;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,47**; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;IVM Project Interface w/Edb
;
;EAS*1*47 - break up Z09's by Income year, via new "ATR" xref
;
REV(IVMREF,DFN,IVMCL,IVMTYP,IVMBF,IVMBT,IVMAB,IVMHLD) ; Interface w/ Rev fct.
; Input: IVMREF -- Bill reference number
; DFN -- Pointer to the patient in file #2
; IVMCL -- Bill Classification [ 1-Inpt, 2-Opt ]
; IVMTYP -- Bill Type [ 2-Copayment, 3-Per Diem ]
; IVMBF -- Bill From Date in FM format
; IVMBT -- Bill To Date in FM format
; IVMAB -- Amount Billed
; IVMHLD -- Charge placed on hold? [ 1-Yes, 0-No ]
;
; Output: New entry created in file #301.61
;
N IVMTDA,DA,DIK
I $G(IVMREF)=""!'$G(DFN) G REVQ
S IVMTDA=$O(^IVM(301.61,"B",IVMREF,0))
I 'IVMTDA S IVMTDA=$$ADD(IVMREF) I 'IVMTDA G REVQ
;
D NOW^%DTC
S $P(^IVM(301.61,IVMTDA,0),"^",2,12)=DFN_"^"_IVMCL_"^"_IVMTYP_"^"_IVMBF_"^"_IVMBT_"^"_$S($G(IVMHLD):"",1:DT)_"^"_IVMAB_"^^^^"_$S($G(IVMHLD):0,1:1),$P(^(1),"^",3,4)=%_"^"_DUZ
S DA=IVMTDA,DIK="^IVM(301.61," D IX1^DIK
REVQ Q
;
ADD(X) ; Add a new entry to file #301.61
; Input: X -- Reference number to be used as the .01 field
; Output: IVM -- Internal entry number to new entry, or 0.
;
N DA,DD,DO,DIE,DIC,DLAYGO,IVM,Y
I $G(X)="" S IVM=0 G ADDQ
S DIC="^IVM(301.61,",DIC(0)="L",DLAYGO=301.61 D FILE^DICN
S (DA,IVM)=+Y I DA<0 S IVM=0 G ADDQ
;
D NOW^%DTC
S DIE=DIC,DR="1.01////"_%_";1.02////"_DUZ D ^DIE
ADDQ Q IVM
;
;
CHK(DFN) ; Is the insurance patient recorded in file #301.61?
; Input: DFN -- Pointer to the patient in file #2
; Output: 1 -- Patient recorded in #301.61; otherwise, 0
;
Q $O(^IVM(301.61,"C",+$G(DFN),0))>0
;
;
FT1(IVMTDA) ; Entry point to build FT1 segment from file #301.61
; Input: IVMTDA -- Pointer to the transmission record in #301.61
; The HL7 variables HLFS, HLQ and HLECH must also be defined
; Output: String in the form of the HL7 FT1 segment
;
N IVMN,IVMY,IVMSEP
I '$G(IVMTDA) G FT1Q
S IVMN=$G(^IVM(301.61,IVMTDA,0)) I IVMN="" G FT1Q
S IVMSEP=$E(HLECH)
;
S $P(IVMY,HLFS,1)=1 ; set id
S $P(IVMY,HLFS,4)=$S($P(IVMN,"^",7):$$HLDATE^HLFNC($P(IVMN,"^",7)),1:HLQ) ; date generated
S $P(IVMY,HLFS,6)=$S($P(IVMN,"^",11):2,$P(IVMN,"^",10)&$P(IVMN,"^",13):4,$P(IVMN,"^",9)&$P(IVMN,"^",13):3,1:1) ; transaction type
S $P(IVMY,HLFS,7)=$P(IVMN,"^") ; transaction code
;
; - build extended transaction description
S $P(IVMY,HLFS,9)=$P(IVMN,"^",3)_IVMSEP_$P(IVMN,"^",4)_IVMSEP_$S($P(IVMN,"^",5):$$HLDATE^HLFNC($P(IVMN,"^",5)),1:HLQ)_IVMSEP_$S($P(IVMN,"^",6):$$HLDATE^HLFNC($P(IVMN,"^",6)),1:HLQ)
;
; - build extended transaction amount
S $P(IVMY,HLFS,11)=$S($P(IVMN,"^",10)&$P(IVMN,"^",13):+$P(IVMN,"^",9),$P(IVMN,"^",9)&$P(IVMN,"^",13):$P(IVMN,"^",9),1:"") ;Amount Collected
S $P(IVMY,HLFS,12)=$P(IVMN,"^",8) ;Amount Billed
;
FT1Q Q "FT1"_HLFS_$G(IVMY)
;
SETATR(DA,DFN) ; Mumps cross reference add logic ;EAS*1*47
Q:'DFN
N ICYR,TSTDT
S TSTDT=$P($G(^IVM(301.61,DA,0)),"^",5)
Q:TSTDT'>0
;find last MT date via Billing From Date
S ICYR=$P($$LST^DGMTU(DFN,TSTDT,1),"^",2)
;calculate income year
S ICYR=$E(ICYR,1,3)-1_"0000"
Q:ICYR'>0
;set if xmit is Yes
S:$P($G(^IVM(301.61,DA,0)),"^",12) ^IVM(301.61,"ATR",ICYR,DFN,DA)=""
Q
KILLATR(DA,DFN) ; Mumps cross reference kill logic ;EAS*1*47
Q:'DFN
N ICYR,TSTDT
S TSTDT=$P($G(^IVM(301.61,DA,0)),"^",5)
;find last MT date for Billing From Date
S ICYR=$P($$LST^DGMTU(DFN,TSTDT,1),"^",2)
;calculate income year
S ICYR=$E(ICYR,1,3)-1_"0000"
K ^IVM(301.61,"ATR",ICYR,DFN,DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASUFNC3 3920 printed Dec 13, 2024@01:55:45 Page 2
EASUFNC3 ;ALB/CPM/EJG/GN - BILLING TRANSMISSION UTILITIES ; 13-JUN-94 [12/22/03 10:30am]
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,47**; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;IVM Project Interface w/Edb
+5 ;
+6 ;EAS*1*47 - break up Z09's by Income year, via new "ATR" xref
+7 ;
REV(IVMREF,DFN,IVMCL,IVMTYP,IVMBF,IVMBT,IVMAB,IVMHLD) ; Interface w/ Rev fct.
+1 ; Input: IVMREF -- Bill reference number
+2 ; DFN -- Pointer to the patient in file #2
+3 ; IVMCL -- Bill Classification [ 1-Inpt, 2-Opt ]
+4 ; IVMTYP -- Bill Type [ 2-Copayment, 3-Per Diem ]
+5 ; IVMBF -- Bill From Date in FM format
+6 ; IVMBT -- Bill To Date in FM format
+7 ; IVMAB -- Amount Billed
+8 ; IVMHLD -- Charge placed on hold? [ 1-Yes, 0-No ]
+9 ;
+10 ; Output: New entry created in file #301.61
+11 ;
+12 NEW IVMTDA,DA,DIK
+13 IF $GET(IVMREF)=""!'$GET(DFN)
GOTO REVQ
+14 SET IVMTDA=$ORDER(^IVM(301.61,"B",IVMREF,0))
+15 IF 'IVMTDA
SET IVMTDA=$$ADD(IVMREF)
IF 'IVMTDA
GOTO REVQ
+16 ;
+17 DO NOW^%DTC
+18 SET $PIECE(^IVM(301.61,IVMTDA,0),"^",2,12)=DFN_"^"_IVMCL_"^"_IVMTYP_"^"_IVMBF_"^"_IVMBT_"^"_$SELECT($GET(IVMHLD):"",1:DT)_"^"_IVMAB_"^^^^"_$SELECT($GET(IVMHLD):0,1:1)
SET $PIECE(^(1),"^",3,4)=%_"^"_DUZ
+19 SET DA=IVMTDA
SET DIK="^IVM(301.61,"
DO IX1^DIK
REVQ QUIT
+1 ;
ADD(X) ; Add a new entry to file #301.61
+1 ; Input: X -- Reference number to be used as the .01 field
+2 ; Output: IVM -- Internal entry number to new entry, or 0.
+3 ;
+4 NEW DA,DD,DO,DIE,DIC,DLAYGO,IVM,Y
+5 IF $GET(X)=""
SET IVM=0
GOTO ADDQ
+6 SET DIC="^IVM(301.61,"
SET DIC(0)="L"
SET DLAYGO=301.61
DO FILE^DICN
+7 SET (DA,IVM)=+Y
IF DA<0
SET IVM=0
GOTO ADDQ
+8 ;
+9 DO NOW^%DTC
+10 SET DIE=DIC
SET DR="1.01////"_%_";1.02////"_DUZ
DO ^DIE
ADDQ QUIT IVM
+1 ;
+2 ;
CHK(DFN) ; Is the insurance patient recorded in file #301.61?
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; Output: 1 -- Patient recorded in #301.61; otherwise, 0
+3 ;
+4 QUIT $ORDER(^IVM(301.61,"C",+$GET(DFN),0))>0
+5 ;
+6 ;
FT1(IVMTDA) ; Entry point to build FT1 segment from file #301.61
+1 ; Input: IVMTDA -- Pointer to the transmission record in #301.61
+2 ; The HL7 variables HLFS, HLQ and HLECH must also be defined
+3 ; Output: String in the form of the HL7 FT1 segment
+4 ;
+5 NEW IVMN,IVMY,IVMSEP
+6 IF '$GET(IVMTDA)
GOTO FT1Q
+7 SET IVMN=$GET(^IVM(301.61,IVMTDA,0))
IF IVMN=""
GOTO FT1Q
+8 SET IVMSEP=$EXTRACT(HLECH)
+9 ;
+10 ; set id
SET $PIECE(IVMY,HLFS,1)=1
+11 ; date generated
SET $PIECE(IVMY,HLFS,4)=$SELECT($PIECE(IVMN,"^",7):$$HLDATE^HLFNC($PIECE(IVMN,"^",7)),1:HLQ)
+12 ; transaction type
SET $PIECE(IVMY,HLFS,6)=$SELECT($PIECE(IVMN,"^",11):2,$PIECE(IVMN,"^",10)&$PIECE(IVMN,"^",13):4,$PIECE(IVMN,"^",9)&$PIECE(IVMN,"^",13):3,1:1)
+13 ; transaction code
SET $PIECE(IVMY,HLFS,7)=$PIECE(IVMN,"^")
+14 ;
+15 ; - build extended transaction description
+16 SET $PIECE(IVMY,HLFS,9)=$PIECE(IVMN,"^",3)_IVMSEP_$PIECE(IVMN,"^",4)_IVMSEP_$SELECT($PIECE(IVMN,"^",5):$$HLDATE^HLFNC($PIECE(IVMN,"^",5)),1:HLQ)_IVMSEP_$SELECT($PIECE(IVMN,"^",6):$$HLDATE^HLFNC($PIECE(IVMN,"^",6)),1:HLQ)
+17 ;
+18 ; - build extended transaction amount
+19 ;Amount Collected
SET $PIECE(IVMY,HLFS,11)=$SELECT($PIECE(IVMN,"^",10)&$PIECE(IVMN,"^",13):+$PIECE(IVMN,"^",9),$PIECE(IVMN,"^",9)&$PIECE(IVMN,"^",13):$PIECE(IVMN,"^",9),1:"")
+20 ;Amount Billed
SET $PIECE(IVMY,HLFS,12)=$PIECE(IVMN,"^",8)
+21 ;
FT1Q QUIT "FT1"_HLFS_$GET(IVMY)
+1 ;
SETATR(DA,DFN) ; Mumps cross reference add logic ;EAS*1*47
+1 if 'DFN
QUIT
+2 NEW ICYR,TSTDT
+3 SET TSTDT=$PIECE($GET(^IVM(301.61,DA,0)),"^",5)
+4 if TSTDT'>0
QUIT
+5 ;find last MT date via Billing From Date
+6 SET ICYR=$PIECE($$LST^DGMTU(DFN,TSTDT,1),"^",2)
+7 ;calculate income year
+8 SET ICYR=$EXTRACT(ICYR,1,3)-1_"0000"
+9 if ICYR'>0
QUIT
+10 ;set if xmit is Yes
+11 if $PIECE($GET(^IVM(301.61,DA,0)),"^",12)
SET ^IVM(301.61,"ATR",ICYR,DFN,DA)=""
+12 QUIT
KILLATR(DA,DFN) ; Mumps cross reference kill logic ;EAS*1*47
+1 if 'DFN
QUIT
+2 NEW ICYR,TSTDT
+3 SET TSTDT=$PIECE($GET(^IVM(301.61,DA,0)),"^",5)
+4 ;find last MT date for Billing From Date
+5 SET ICYR=$PIECE($$LST^DGMTU(DFN,TSTDT,1),"^",2)
+6 ;calculate income year
+7 SET ICYR=$EXTRACT(ICYR,1,3)-1_"0000"
+8 KILL ^IVM(301.61,"ATR",ICYR,DFN,DA)
+9 QUIT
