IBCU4	;ALB/AAS - BILLING UTILITY ROUTINE (CONTINUED) ;12-FEB-90
	;;2.0;INTEGRATED BILLING;**109,122,137,245,349,371**;21-MAR-94;Build 57
	;;Per VHA Directive 2004-038, this routine should not be modified.
	;
	;MAP TO DGCRU4
	;
DDAT	;Input transform for Statement Covers From field
	I '$D(DA) G TO
	S IB00=+$P(^DGCR(399,+DA,0),"^",3) I +X<$P(IB00,".",1) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X G DDAT4
	I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4
	D PROCDT
	I DGPRDTB,X>DGPRDTB K X W !?4,"Can't be greater than date of specified Procedures!",*7 G DDAT4
	G DDAT4
DDAT1	;Input transform for Statement covers to
	I '$D(DA) G FROM
	S IB00=$S($D(^DGCR(399,+DA,"U")):$P(^("U"),"^",1),1:"") I 'IB00 W !?4,"'Start Date' must be specified first!",*7 K X G DDAT4
	I +X>DT W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4
	I +X<IB00 W !?4,"Cannot preceed the 'Start Date'!",*7 K X G DDAT4
	;I $S($E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4
	;I $$FY(+IB00)'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4
	;I $E(IB00,1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 G DDAT4
	D PROCDT
	I DGPRDTE,X<DGPRDTE K X W !?4,"Can't be less than date of specified Procedures!",*7 G DDAT4
	G DDAT4
	;
	;DDAT2   ;Input transform for OP VISITS DATE(S) field  REPLACED WITH IBCU41 6/15/93
	;S IB00=$G(^DGCR(399,IBIFN,"U")) I $P(IB00,"^",1)']"" W !?4,*7,"No 'Start Date' on file...can't enter OP visit dates..." K X G DDAT4
	;I $P(IB00,"^",2)']"" W !?4,*7,"No 'End Date' on file...can't enter OP visit dates..." K X G DDAT4
	;I X<$P(IB00,"^",1) W !?4,*7,"Can't enter a visit date prior to 'Start Date'..." K X G DDAT4
	;I X>$P(IB00,"^",2) W !?4,*7,"Can't enter a visit date later than 'End Date'..." K X G DDAT4
	;I $P(^DGCR(399,IBIFN,0),"^",19)'=2,$D(^DGCR(399,"ASC2",IBIFN)),$O(^DGCR(399,IBIFN,"OP",0)) W !?4,*7,"Only 1 visit date allowed on bills with Amb. Surg. Codes!" K X G DDAT4
	;D APPT^IBCU3,DUPCHK^IBCU3
	G DDAT4
	;
DDAT3	; - x-ref call for to and from dates, REPLACED BY TRIGGERS ON .08, 151, 152 ON 10/18/93
	;if inpatient bill return DGNEWLOS to cause recalc of los in IBSC6
	G DDAT4:'$D(X)
	I $D(^DGCR(399,DA,0)),$P(^(0),"^",5)<3 S DGNEWLOS=1
	S IB00=$S($D(^DGCR(399,+DA,"U")):^("U"),1:"") I IB00']"" K X G DDAT4
	S IB02=$S(+$E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1),IB01=$E(IB00,1)_IB02_"0930",$P(^DGCR(399,DA,"U1"),"^",9)=IB02 ;,$P(^DGCR(399,DA,"U1"),"^",11)=$S($P(IB00,"^",2)>IB01:IB02+1,1:"")
	;I $P(^DGCR(399,DA,"U1"),"^",11)="" S $P(^("U1"),"^",12)=""
	;
DDAT4	K IB00,IB01,IB02,IB03,DGX,DGNOAP,DGJ,DGPROC,DGPRDT,DGPRDTE,DGPRDTB Q
	;
OTDAT	; Input transform for Other Care Start Date (399,48,.02)
	I ('$G(DA(1)))!('$G(X)) Q
	N IBX S IBX=$G(^DGCR(399,DA(1),"U"))
	I +X<+IBX W !,?4,"Can Not Precede Bill Start Date!",!,*7 K X Q
	I +X>+$P(IBX,U,2) W !,?4,"Can not be after Bill End Date!",!,*7 K X Q
	Q
	;
CHDAT	; Input transform for chiropractics-related dates (399/245,246,247)
	; Make sure that date entered is not after end date of the bill
	Q:'$D(X)
	N IBX,Y
	S IBX=$P($G(^DGCR(399,+DA,"U")),U,2)
	I IBX="" W !?4,*7,"No end date of the bill on file - can't enter chiropractics-related dates " K X Q
	I X>+IBX S Y=IBX D DD^%DT W !,?4,*7,"This date can not be after the end date of the claim ("_Y_") " K X Q
	Q
	;
TO	;151 pseudo input x-form
	I +X_.9<IBIDS(.03) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X Q
	I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X
	Q
FROM	;152 pseudo input x-form
	I '$D(IBIDS(151)) W !?4,"'Start Date' must be specified first!",*7 K X Q
	I +X<IBIDS(151) W !?4,"Cannot preceed the 'Start Date'!",*7 K X Q
	;I $S($E(IBIDS(151),4,5)<10:$E(IBIDS(151),2,3),1:$E(IBIDS(151),2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 Q
	;I $$FY(IBIDS(151))'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 Q
	;I $E(IBIDS(151),1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 Q
	Q
	;
FY(DATE)	; return a dates Fiscal Year
	N IBYR,IBFY S IBFY=""
	I $G(DATE)?7N.E S IBYR=$S($E(DATE,4,5)<10:$E(DATE,1,3),1:$E(DATE,1,3)+1),IBFY=$E(IBYR,2,3)
	Q IBFY
	;
SPEC	;  - calculate discharge specialty
	;  - input  IBids(.08) = ptf record number
	;  - output IBids(161) = pointer to billing specialty in 399.1
	K IBIDS(161)
	Q:$S('$D(IBIDS(.08)):1,'$D(^DGPT(+IBIDS(.08),70)):1,'$P(^(70),"^",2):1,'$D(^DIC(42.4,+$P(^(70),"^",2),0)):1,1:0)  S IBIDS(161)=$P(^DGPT(IBIDS(.08),70),"^",2)
	S IBIDS(161)=$P($G(^DIC(42.4,+IBIDS(161),0)),"^",5) I IBIDS(161)="" K IBIDS(161) Q
	S IBIDS(161)=$O(^DGCR(399.1,"B",IBIDS(161),0))
	I '$D(^DGCR(399.1,+IBIDS(161),0)) K IBIDS(161)
	Q
	;
PROCDT	;  - find first and last dates of procedures
	;    can't set from and to date inside of this range
	S (DGPRDT,DGPROC,DGPRDTE,DGPRDTB)=0
	F  S DGPROC=$O(^DGCR(399,+DA,"CP",DGPROC)) Q:'DGPROC  S DGPRDT=$P($G(^DGCR(399,+DA,"CP",DGPROC,0)),"^",2) D
	. I DGPRDTB=0!(DGPRDTB>DGPRDT) S DGPRDTB=DGPRDT
	. I DGPRDTE=0!(DGPRDTE<DGPRDT) S DGPRDTE=DGPRDT
	. Q
	Q
	;
TOBIN(Y,DA)	; Screen for UB-04 bill classification based on UB-04 location of care
	; Y = internal value of code for field .25 (UB-04 BILL CLASSIFICATION)
	; DA = bill ien in file 399
	N IB0
	S IB0=$P($G(^DGCR(399,DA,0)),U,24) ; Get UB-04 LOCATION OF CARE value
	Q $S('IB0:0,(","_$P($G(^DGCR(399.1,+Y,0)),U,24)_",")'[(","_IB0_","):0,1:1)
	;
TRIG05(X,D0)	; Trigger executed on field .05 of file 399 to set field .25
	; Find the correct entry in file 399.1 that corresponds to the value in .05
	; X = value of field .05, location of care
	; D0 = IEN of bill entry in file 399
	N Z,Z0,IEN,LOC
	S LOC=$P($G(^DGCR(399,D0,0)),U,4)
	S IEN="",Z=0
	I LOC'="" F  S Z=$O(^DGCR(399.1,"C",X,Z)) Q:'Z  S Z0=$P($G(^DGCR(399.1,Z,0)),U,23,24) I +Z0,(","_$P(Z0,U,2)_",")[(","_LOC_",") S IEN=Z Q
	Q IEN
	;
TOB(IBIFN,POS)	;Function returns the 3 digit type of bill from UB-04
	;  fields or the position (1-3) as determined by POS (optional)
	N Z
	S Z=$P($G(^DGCR(399,IBIFN,0)),U,24,26),Z=$P(Z,U)_$P($G(^DGCR(399.1,+$P(Z,U,2),0)),U,2)_$P(Z,U,3)
	Q $S('$G(POS):Z,1:$E(Z,+POS))
	;
