Index: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF1.m
===================================================================
--- WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF1.m	(revision 623)
@@ -1,221 +1,215 @@
-IBCEF1	;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS - CONT ;30-JAN-96
-	;;2.0;INTEGRATED BILLING;**52,124,51,137,210,155,349,371**;21-MAR-94;Build 57
-	;;Per VHA Directive 2004-038, this routine should not be modified.
-	;
-OCC(IBIFN,REL,TEXT)	;Sets up an arrays of occurrence codes for various cks
-	;RETURNS 1^additional data for entry IBXSAVE("OCC",n) if REL or TEXT
-	;   parameters have been met or null if conditions not met
-	;If no REL or TEXT parameters sent, just extract codes array
-	; IBIFN = bill ien
-	; REL = 'OCC RELATED TO' value to check for
-	; TEXT = text to check for the .01 field of 399.1 entry pointed to
-	;         by the occurrence code
-	N OCC,SORT,ARR,N,DATA,CODE,CT
-	I '$D(IBXSAVE("OCC")),'$D(IBXSAVE("OCCS")) D
-	.N IBI,Z,CT1,CT2,Z0 S (IBI,CT1,CT2)=0
-	.F  S IBI=$O(^DGCR(399,IBIFN,"OC",IBI)) Q:'IBI  S Z=$G(^(IBI,0)) D
-	..S Z0=$G(^DGCR(399.1,+Z,0))
-	..Q:'$P(Z0,U,10)&'$P(Z0,U,4)  ;Not an occurrence code
-	..I $P(Z0,U,10) S CT2=CT2+1,IBXSAVE("OCCS",CT2)=$S($P(Z0,U,4):$P(Z0,U,2)_U_$P(Z,U,2),1:U)_U_$P(Z,U,4)_U_$P(Z0,U)_U_$P(Z0,U,9)_U_$P(Z,U,3)_U_$P(Z,U,2)
-	..I '$P(Z0,U,10) S CT1=CT1+1,IBXSAVE("OCC",CT1)=$S($P(Z0,U,4):$P(Z0,U,2)_U_$P(Z,U,2),1:U)_U_U_$P(Z0,U)_U_$P(Z0,U,9)_U_$P(Z,U,3)_U_$P(Z,U,2)
-	I '$D(IBXSAVE("OCC"))&'$D(IBXSAVE("OCCS")) S IBXSAVE("OCC")="" G OCCQ
-	;
-	; esg - IB*2*349 - order the occurrence codes
-	;       Build the SORT array sorted by the occ code
-	F ARR="OCC","OCCS" S N=0 F  S N=$O(IBXSAVE(ARR,N)) Q:'N  S DATA=$G(IBXSAVE(ARR,N)) I $P(DATA,U,1)'="" S CODE=" "_$P(DATA,U,1),SORT(ARR,CODE,N)=DATA
-	;       Loop thru the SORT array and re-build the IBXSAVE array
-	F ARR="OCC","OCCS" K IBXSAVE(ARR) S CODE="",CT=0 F  S CODE=$O(SORT(ARR,CODE)) Q:CODE=""  S N=0 F  S N=$O(SORT(ARR,CODE,N)) Q:'N  S CT=CT+1,IBXSAVE(ARR,CT)=SORT(ARR,CODE,N)
-	;
-	I $G(REL)'=""!($G(TEXT)'="") D OCC1("",.OCC,$G(REL),$G(TEXT)) D:'$D(OCC) OCC1("S",.OCC,$G(REL),$G(TEXT))
-OCCQ	Q $G(OCC)
-	;
-OCC1(ARR,OCC,REL,TEXT)	; Search thru local array for parameters met
-	; ARR = null to search OCC subscript, "S" to search OCCS subscript
-	N Z
-	S ARR="OCC"_ARR,Z=0
-	F  S Z=$O(IBXSAVE(ARR,Z)) Q:'Z  D
-	.I $G(REL)'="",$P(IBXSAVE(ARR,Z),U,5)=REL S OCC="1"_$S(REL=2:U_$P(IBXSAVE(ARR,Z),U,6),1:"") Q
-	.I $G(TEXT)'="",$P(IBXSAVE(ARR,Z),U,4)=TEXT S OCC="1^"_$P(IBXSAVE(ARR,Z),U,7)
-	Q
-	;
-RX(IBIFN)	; Format billable prescription data for refills for 837
-	N Z,IBXDATA,CT
-	I '$D(IBXSAVE("BOX24")) D B24^IBCEF3(.IBXSAVE,IBIFN,1)
-	S Z="",CT=0
-	F  S Z=$O(IBXSAVE("BOX24",Z)) Q:Z=""  I $D(IBXSAVE("BOX24",Z,"RX")) S CT=CT+1,IBXDATA(Z)=IBXSAVE("BOX24",Z,"RX")
-RXQ	Q CT
-	;
-OTHPAY(IBIFN,SEQ)	; Return the other insurance payment amount for bill
-	;  IBIFN and payer sequence SEQ (1-3)
-	N AMT,IBIFN1
-	S IBIFN1=$P($G(^DGCR(399,IBIFN,"M1")),U,SEQ+4)
-	I IBIFN1 D
-	. I $$MCRWNR^IBEFUNC(+$G(^DGCR(399,IBIFN,"I"_SEQ))) S AMT=$$MCRPAY^IBCEU0(IBIFN) Q
-	. S AMT=+$$TPR^PRCAFN(IBIFN1) Q:AMT  ; A/R amount
-	. S AMT=+$P($G(^DGCR(399,IBIFN,"U2")),U,SEQ+3) ; amount on bill
-	Q $G(AMT)
-	;
-OUTPT(IBIFN,IBPRINT)	; Moved for space
-	D OUTPT^IBCEF11(IBIFN,$G(IBPRINT))
-	Q
-	;
-OCC92	;Reformats IBXSAVE("OCC") and IBXSAVE("OCCS") to fit blocks on UB-04
-	; Set up IBXSAVE(32-36) arrays
-	N IBPG,IB32,IB33,IB34,IB35,IB36,IBFL,Z,Z0,PG
-	S IBPG=0
-	F Z=32:1:36 K IBFL(Z) S IBFL(Z)=0
-	M IB32=IBXSAVE("OCC"),IB36=IBXSAVE("OCCS")
-	S IB32=$O(IB32(""),-1),IB36=$O(IB36(""),-1),PG=1
-	D OCC^IBCF32
-	F Z=32:1:36 S Z0="" F  S Z0=$O(IBFL(Z,Z0)) Q:'Z0  S IBXSAVE("OC92",Z,Z0)=$P(IBFL(Z,Z0),U,1,3)
-	Q
-	;
-BATCH()	; Moved for space IB*2*349
-	Q $$BATCH^IBCEF11()
-	;
-PROC(T,TYPE)	; Find procedure code, strip '.' Function returns result
-	; T = Procedure internal entry #;file reference
-	; TYPE = "CPT" for only CPT/HCPCS valid
-	;        "ICD" for only ICD9 valid or null for either
-	N Q,S
-	S Q="",S="^"_$P($P(T,";",2),"(")
-	I $G(TYPE)="" D
-	. I $E(S,2,3)="IC" S Q=$P($$PRCD(T),U) Q
-	. I T["DIC(81.3" S Q=$$MOD^ICPTMOD(+T,"I") S Q=$S(Q>0:$P(Q,U,4),1:"")
-	I $G(TYPE)="CPT",$E(S,2,3)="IC" S Q=$$PRCD(T) Q
-	I $G(TYPE)="ICD",T["ICD0" S Q=$P($$ICD0^IBACSV(+T),U)
-	Q $TR(Q,".")
-	;
-FACILITY(IBIFN)	;return the Facility (Institution pointer-#4) for a bill
-	; the institution of the Bill Division (399,.22) if defined, otherwise the Facility Name (350.9,.02)
-	;
-	N IB0,IBIN S IBIN=0
-	S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I +$P(IB0,U,22) S IBIN=$$SITE^VASITE(+$P(IB0,U,3),+$P(IB0,U,22))
-	I IBIN'>0 S IBIN=+$P($G(^IBE(350.9,1,0)),U,2)
-	Q +IBIN
-	;
-ISRX(IBIFN)	; Function to determine if bill is a prescription refill bill
-	; Returns 0 if no Rx on bill or 1 if there is.
-	;
-	N IBRX
-	I $D(^IBA(362.4,"AIFN"_IBIFN)) S IBRX=1
-	Q +$G(IBRX)
-	;
-ISPROS(IBIFN)	; Function to determine if bill is a prosthetics bill
-	; Returns 0 if no Prosthetics on bill or 1 if there is.
-	;
-	N IBPROS
-	I $D(^IBA(362.5,"AIFN"_IBIFN)) S IBPROS=1
-	Q +$G(IBPROS)
-	;
-FINDINS(IBIFN,IBSEQ)	; Returns the internal entry number of the insurance
-	;  company for bill ien IBIFN for payer sequence IBSEQ (or current if
-	;  IBSEQ is null)
-	Q $P($G(^DGCR(399,IBIFN,"I"_$$COBN^IBCEF(IBIFN,$G(IBSEQ)))),U)
-	;
-TOB(IBIFN)	; Returns UB-04 type of bill from data in the output formatter
-	N IBTOB,IBZ1,IBZ2,IBZ3
-	D F^IBCEF("N-UB-04 LOCATION OF CARE","IBZ1",,IBIFN)
-	D F^IBCEF("N-UB-04 BILL CLASSIFICATION","IBZ2",,IBIFN)
-	D F^IBCEF("N-UB-04 TIMEFRAME OF BILL","IBZ3",,IBIFN)
-	S IBTOB=IBZ1_IBZ2_IBZ3
-	Q IBTOB
-	;
-PRCD(PRIEN,ALL,EDT)	; Function returns the code that corresponds to the variable
-	; pointer data in PRIEN (ien;file)
-	; ALL = if ALL=1, returns the entire $$CPT^ICPTCOD for CPT or
-	;       ^code^name format for ICD result
-	;       or null if lookup fails
-	; EDT = Effective date to check (not used if +$G(ALL)=0)
-	N CODE,IBX
-	S CODE=""
-	;Modified for Code Set Versioning
-	I PRIEN["ICPT" S IBX=$$CPT^ICPTCOD(+PRIEN,$G(EDT)) G:IBX'>0 PRCDQ S CODE=$S($G(ALL):IBX,1:$P(IBX,U,2))
-	I PRIEN["ICD0" S IBX=$$ICD0^IBACSV(+PRIEN,$G(EDT)) G:IBX="" PRCDQ S CODE=$S($G(ALL):U_$P(IBX,U)_U_$P(IBX,U,4),1:$P(IBX,U))
-PRCDQ	Q CODE
-	;
-NFT(FT,IBIFN)	; Returns 1 if bill IBIFN is not of form type FT (internal)
-	; so the data element should not be required
-	S FT=$S($$FT^IBCEF(IBIFN)=FT:0,1:1)
-	Q FT
-	;
-REQ(FT,INP,IBIFN)	; Determine if bill IBIFN is of form type FT and
-	; Inpatient (I) or Outpatient (O) status INP [or either if (null)] 
-	;
-	;Returns 1 if both conditions FT and INP match for the bill
-	; or 0 if either of these conditions are not true
-	; I $$REQ^IBCEF1(2,"I",1) would mean if bill entry #1 is
-	;                         CMS-1500/inpatient the data would be required
-	; I '$$REQ^IBCEF1(2,"I",1) would mean if bill entry #1 is anything but
-	;                          CMS-1500/inpatient, the data would not be
-	;                          required
-	N Z
-	S Z=1
-	S:$$NFT(FT,IBIFN) Z=0 ; Not the form type for requirement
-	I Z,$G(INP)'="" D
-	. S Z0=$$INPAT^IBCEF(IBIFN,1),INP=$G(INP)
-	. S Z=$S(Z0:INP="I",1:INP="O") ;Check if I/O matches required state
-	Q Z
-	;
-SET1(IBIFN,A,IBZ,IBXDATA,IBXNOREQ)	; Utility to set variables for output
-	; formatter for professional EDI 
-	; Returns values of A, IBXDATA, IBZ, IBXNOREQ
-	N Z,CT
-	S A="^TMP($J,""IBLCT"")"
-	S (Z,CT)=0
-	F  S Z=$O(IBXDATA(Z)) Q:'Z  D  ; Don't transmit 0-charges
-	. I $P(IBXDATA(Z),U,9),$P(IBXDATA(Z),U,8) S CT=CT+1 M IBZ(CT)=IBXDATA(Z)
-	K IBXDATA
-	S IBXNOREQ='$$REQ(2,"O",IBIFN)
-	Q
-	;
-CIADDR(IBXDATA,IBXSAVE,LINE,FORM)	; Format current ins co address line LINE for FORM
-	; FORM = 1 for CMS-1500, 2 for UB-04
-	; Called from output formatter - both IBXDATA, IBXSAVE parameters are
-	;  passed by reference
-	;
-	K IBXDATA
-	I $G(FORM)'=1 D
-	. ;
-	. ; esg - 11/17/06 - IB*2*349 - UB-04 FL-38 contains the payer name
-	. ;       and address on 4 lines within this 5 line box.  All 5 lines
-	. ;       are formatted here into the IBXDATA array.  This is the
-	. ;       address that shows through the envelope window.
-	. ;
-	. ; esg - 9/13/07 - IB*2*371 - Line 1 of this box contains the print
-	. ;       status (i.e. copy, 2nd notice, 3rd notice, MRA needed).
-	. ;
-	. N Z,Z1,LM,Q,ADDR,X,IBPSTAT
-	. S LM=$P($G(^IBE(350.9,1,1)),U,31)   ; UB address column parameter
-	. S Z=""
-	. I LM S $P(Z," ",LM)=""              ; beginning spaces indent
-	. S ADDR=$G(IBXSAVE("CADR"))          ; address data string
-	. ;
-	. D F^IBCEF("N-PRINT BILL SUBMIT STATUS","IBPSTAT",,+$G(IBXIEN))
-	. S Z1=Z I Z1="" S Z1=" "     ; line 1 can't start in column 1
-	. S IBXDATA(1)=Z1_$G(IBPSTAT),Q=1             ; line 1 print status
-	. S Q=Q+1
-	. S IBXDATA(Q)=Z_$G(IBXSAVE("CADR_NAME"))     ; line 2 payer name
-	. S X=$P(ADDR,U,1)
-	. I X'="" S Q=Q+1,IBXDATA(Q)=Z_X              ; address line 1
-	. S X=$P(ADDR,U,2)
-	. I X'="" S Q=Q+1,IBXDATA(Q)=Z_X D            ; address line 2
-	.. S X=$P(ADDR,U,3)
-	.. I X'="" S IBXDATA(Q)=IBXDATA(Q)_" "_X      ; address line 3
-	.. Q
-	. S Q=Q+1                                     ; city,st,zip on last line
-	. S IBXDATA(Q)=Z_$P(ADDR,U,4)_", "_$$STATE^IBCEFG1($P(ADDR,U,5))_" "_$P(ADDR,U,6)
-	. KILL IBXSAVE("CADR_NAME"),IBXSAVE("CADR")   ; cleanup
-	. Q
-	;
-	I $G(FORM)=1 D           ; CMS-1500
-	. N CT,X,Z
-	. S:'$D(IBXSAVE("INDENT")) Z="",$P(Z," ",+$P($G(^IBE(350.9,1,1)),U,27)+1)="",IBXSAVE("INDENT")=Z
-	. S CT=0
-	. S X=$P(IBXSAVE("CADR"),U) S:X'="" CT=CT+1,IBXDATA(CT)=IBXSAVE("INDENT")_X
-	. S X=$S($P(IBXSAVE("CADR"),U,2)'="":$P(IBXSAVE("CADR"),U,2),1:"")_$S($P(IBXSAVE("CADR"),U,2)'="":" ",1:"")_$P(IBXSAVE("CADR"),U,3) S:X'="" CT=CT+1,IBXDATA(CT)=IBXSAVE("INDENT")_X
-	. S CT=CT+1,IBXDATA(CT)=IBXSAVE("INDENT")_$P(IBXSAVE("CADR"),U,4)_", "_$$STATE^IBCEFG1($P(IBXSAVE("CADR"),U,5))_" "_$P(IBXSAVE("CADR"),U,6)
-	. Q
-	;
-	Q
-	;
+IBCEF1 ;ALB/TMP - FORMATTER SPECIFIC BILL FUNCTIONS - CONT ;30-JAN-96
+ ;;2.0;INTEGRATED BILLING;**52,124,51,137,210,155,349**;21-MAR-94;Build 46
+ ;;Per VHA Directive 2004-038, this routine should not be modified.
+ ;
+OCC(IBIFN,REL,TEXT) ;Sets up an arrays of occurrence codes for various cks
+ ;RETURNS 1^additional data for entry IBXSAVE("OCC",n) if REL or TEXT
+ ;   parameters have been met or null if conditions not met
+ ;If no REL or TEXT parameters sent, just extract codes array
+ ; IBIFN = bill ien
+ ; REL = 'OCC RELATED TO' value to check for
+ ; TEXT = text to check for the .01 field of 399.1 entry pointed to
+ ;         by the occurrence code
+ N OCC,SORT,ARR,N,DATA,CODE,CT
+ I '$D(IBXSAVE("OCC")),'$D(IBXSAVE("OCCS")) D
+ .N IBI,Z,CT1,CT2,Z0 S (IBI,CT1,CT2)=0
+ .F  S IBI=$O(^DGCR(399,IBIFN,"OC",IBI)) Q:'IBI  S Z=$G(^(IBI,0)) D
+ ..S Z0=$G(^DGCR(399.1,+Z,0))
+ ..Q:'$P(Z0,U,10)&'$P(Z0,U,4)  ;Not an occurrence code
+ ..I $P(Z0,U,10) S CT2=CT2+1,IBXSAVE("OCCS",CT2)=$S($P(Z0,U,4):$P(Z0,U,2)_U_$P(Z,U,2),1:U)_U_$P(Z,U,4)_U_$P(Z0,U)_U_$P(Z0,U,9)_U_$P(Z,U,3)_U_$P(Z,U,2)
+ ..I '$P(Z0,U,10) S CT1=CT1+1,IBXSAVE("OCC",CT1)=$S($P(Z0,U,4):$P(Z0,U,2)_U_$P(Z,U,2),1:U)_U_U_$P(Z0,U)_U_$P(Z0,U,9)_U_$P(Z,U,3)_U_$P(Z,U,2)
+ I '$D(IBXSAVE("OCC"))&'$D(IBXSAVE("OCCS")) S IBXSAVE("OCC")="" G OCCQ
+ ;
+ ; esg - IB*2*349 - order the occurrence codes
+ ;       Build the SORT array sorted by the occ code
+ F ARR="OCC","OCCS" S N=0 F  S N=$O(IBXSAVE(ARR,N)) Q:'N  S DATA=$G(IBXSAVE(ARR,N)) I $P(DATA,U,1)'="" S CODE=" "_$P(DATA,U,1),SORT(ARR,CODE,N)=DATA
+ ;       Loop thru the SORT array and re-build the IBXSAVE array
+ F ARR="OCC","OCCS" K IBXSAVE(ARR) S CODE="",CT=0 F  S CODE=$O(SORT(ARR,CODE)) Q:CODE=""  S N=0 F  S N=$O(SORT(ARR,CODE,N)) Q:'N  S CT=CT+1,IBXSAVE(ARR,CT)=SORT(ARR,CODE,N)
+ ;
+ I $G(REL)'=""!($G(TEXT)'="") D OCC1("",.OCC,$G(REL),$G(TEXT)) D:'$D(OCC) OCC1("S",.OCC,$G(REL),$G(TEXT))
+OCCQ Q $G(OCC)
+ ;
+OCC1(ARR,OCC,REL,TEXT) ; Search thru local array for parameters met
+ ; ARR = null to search OCC subscript, "S" to search OCCS subscript
+ N Z
+ S ARR="OCC"_ARR,Z=0
+ F  S Z=$O(IBXSAVE(ARR,Z)) Q:'Z  D
+ .I $G(REL)'="",$P(IBXSAVE(ARR,Z),U,5)=REL S OCC="1"_$S(REL=2:U_$P(IBXSAVE(ARR,Z),U,6),1:"") Q
+ .I $G(TEXT)'="",$P(IBXSAVE(ARR,Z),U,4)=TEXT S OCC="1^"_$P(IBXSAVE(ARR,Z),U,7)
+ Q
+ ;
+RX(IBIFN) ; Format billable prescription data for refills for 837
+ N Z,IBXDATA,CT
+ I '$D(IBXSAVE("BOX24")) D B24^IBCEF3(.IBXSAVE,IBIFN,1)
+ S Z="",CT=0
+ F  S Z=$O(IBXSAVE("BOX24",Z)) Q:Z=""  I $D(IBXSAVE("BOX24",Z,"RX")) S CT=CT+1,IBXDATA(Z)=IBXSAVE("BOX24",Z,"RX")
+RXQ Q CT
+ ;
+OTHPAY(IBIFN,SEQ) ; Return the other insurance payment amount for bill
+ ;  IBIFN and payer sequence SEQ (1-3)
+ N AMT,IBIFN1
+ S IBIFN1=$P($G(^DGCR(399,IBIFN,"M1")),U,SEQ+4)
+ I IBIFN1 D
+ . I $$MCRWNR^IBEFUNC(+$G(^DGCR(399,IBIFN,"I"_SEQ))) S AMT=$$MCRPAY^IBCEU0(IBIFN) Q
+ . S AMT=+$$TPR^PRCAFN(IBIFN1) Q:AMT  ; A/R amount
+ . S AMT=+$P($G(^DGCR(399,IBIFN,"U2")),U,SEQ+3) ; amount on bill
+ Q $G(AMT)
+ ;
+OUTPT(IBIFN,IBPRINT) ; Moved for space
+ D OUTPT^IBCEF11(IBIFN,$G(IBPRINT))
+ Q
+ ;
+OCC92 ;Reformats IBXSAVE("OCC") and IBXSAVE("OCCS") to fit blocks on UB-04
+ ; Set up IBXSAVE(32-36) arrays
+ N IBPG,IB32,IB33,IB34,IB35,IB36,IBFL,Z,Z0,PG
+ S IBPG=0
+ F Z=32:1:36 K IBFL(Z) S IBFL(Z)=0
+ M IB32=IBXSAVE("OCC"),IB36=IBXSAVE("OCCS")
+ S IB32=$O(IB32(""),-1),IB36=$O(IB36(""),-1),PG=1
+ D OCC^IBCF32
+ F Z=32:1:36 S Z0="" F  S Z0=$O(IBFL(Z,Z0)) Q:'Z0  S IBXSAVE("OC92",Z,Z0)=$P(IBFL(Z,Z0),U,1,3)
+ Q
+ ;
+BATCH() ; Moved for space IB*2*349
+ Q $$BATCH^IBCEF11()
+ ;
+PROC(T,TYPE) ; Find procedure code, strip '.' Function returns result
+ ; T = Procedure internal entry #;file reference
+ ; TYPE = "CPT" for only CPT/HCPCS valid
+ ;        "ICD" for only ICD9 valid or null for either
+ N Q,S
+ S Q="",S="^"_$P($P(T,";",2),"(")
+ I $G(TYPE)="" D
+ . I $E(S,2,3)="IC" S Q=$P($$PRCD(T),U) Q
+ . I T["DIC(81.3" S Q=$$MOD^ICPTMOD(+T,"I") S Q=$S(Q>0:$P(Q,U,4),1:"")
+ I $G(TYPE)="CPT",$E(S,2,3)="IC" S Q=$$PRCD(T) Q
+ I $G(TYPE)="ICD",T["ICD0" S Q=$P($$ICD0^IBACSV(+T),U)
+ Q $TR(Q,".")
+ ;
+FACILITY(IBIFN) ;return the Facility (Institution pointer-#4) for a bill
+ ; the institution of the Bill Division (399,.22) if defined, otherwise the Facility Name (350.9,.02)
+ ;
+ N IB0,IBIN S IBIN=0
+ S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I +$P(IB0,U,22) S IBIN=$$SITE^VASITE(+$P(IB0,U,3),+$P(IB0,U,22))
+ I IBIN'>0 S IBIN=+$P($G(^IBE(350.9,1,0)),U,2)
+ Q +IBIN
+ ;
+ISRX(IBIFN) ; Function to determine if bill is a prescription refill bill
+ ; Returns 0 if no Rx on bill or 1 if there is.
+ ;
+ N IBRX
+ I $D(^IBA(362.4,"AIFN"_IBIFN)) S IBRX=1
+ Q +$G(IBRX)
+ ;
+ISPROS(IBIFN) ; Function to determine if bill is a prosthetics bill
+ ; Returns 0 if no Prosthetics on bill or 1 if there is.
+ ;
+ N IBPROS
+ I $D(^IBA(362.5,"AIFN"_IBIFN)) S IBPROS=1
+ Q +$G(IBPROS)
+ ;
+FINDINS(IBIFN,IBSEQ) ; Returns the internal entry number of the insurance
+ ;  company for bill ien IBIFN for payer sequence IBSEQ (or current if
+ ;  IBSEQ is null)
+ Q $P($G(^DGCR(399,IBIFN,"I"_$$COBN^IBCEF(IBIFN,$G(IBSEQ)))),U)
+ ;
+TOB(IBIFN) ; Returns UB-04 type of bill from data in the output formatter
+ N IBTOB,IBZ1,IBZ2,IBZ3
+ D F^IBCEF("N-UB-04 LOCATION OF CARE","IBZ1",,IBIFN)
+ D F^IBCEF("N-UB-04 BILL CLASSIFICATION","IBZ2",,IBIFN)
+ D F^IBCEF("N-UB-04 TIMEFRAME OF BILL","IBZ3",,IBIFN)
+ S IBTOB=IBZ1_IBZ2_IBZ3
+ Q IBTOB
+ ;
+PRCD(PRIEN,ALL,EDT) ; Function returns the code that corresponds to the variable
+ ; pointer data in PRIEN (ien;file)
+ ; ALL = if ALL=1, returns the entire $$CPT^ICPTCOD for CPT or
+ ;       ^code^name format for ICD result
+ ;       or null if lookup fails
+ ; EDT = Effective date to check (not used if +$G(ALL)=0)
+ N CODE,IBX
+ S CODE=""
+ ;Modified for Code Set Versioning
+ I PRIEN["ICPT" S IBX=$$CPT^ICPTCOD(+PRIEN,$G(EDT)) G:IBX'>0 PRCDQ S CODE=$S($G(ALL):IBX,1:$P(IBX,U,2))
+ I PRIEN["ICD0" S IBX=$$ICD0^IBACSV(+PRIEN,$G(EDT)) G:IBX="" PRCDQ S CODE=$S($G(ALL):U_$P(IBX,U)_U_$P(IBX,U,4),1:$P(IBX,U))
+PRCDQ Q CODE
+ ;
+NFT(FT,IBIFN) ; Returns 1 if bill IBIFN is not of form type FT (internal)
+ ; so the data element should not be required
+ S FT=$S($$FT^IBCEF(IBIFN)=FT:0,1:1)
+ Q FT
+ ;
+REQ(FT,INP,IBIFN) ; Determine if bill IBIFN is of form type FT and
+ ; Inpatient (I) or Outpatient (O) status INP [or either if (null)] 
+ ;
+ ;Returns 1 if both conditions FT and INP match for the bill
+ ; or 0 if either of these conditions are not true
+ ; I $$REQ^IBCEF1(2,"I",1) would mean if bill entry #1 is
+ ;                         CMS-1500/inpatient the data would be required
+ ; I '$$REQ^IBCEF1(2,"I",1) would mean if bill entry #1 is anything but
+ ;                          CMS-1500/inpatient, the data would not be
+ ;                          required
+ N Z
+ S Z=1
+ S:$$NFT(FT,IBIFN) Z=0 ; Not the form type for requirement
+ I Z,$G(INP)'="" D
+ . S Z0=$$INPAT^IBCEF(IBIFN,1),INP=$G(INP)
+ . S Z=$S(Z0:INP="I",1:INP="O") ;Check if I/O matches required state
+ Q Z
+ ;
+SET1(IBIFN,A,IBZ,IBXDATA,IBXNOREQ) ; Utility to set variables for output
+ ; formatter for professional EDI 
+ ; Returns values of A, IBXDATA, IBZ, IBXNOREQ
+ N Z,CT
+ S A="^TMP($J,""IBLCT"")"
+ S (Z,CT)=0
+ F  S Z=$O(IBXDATA(Z)) Q:'Z  D  ; Don't transmit 0-charges
+ . I $P(IBXDATA(Z),U,9),$P(IBXDATA(Z),U,8) S CT=CT+1 M IBZ(CT)=IBXDATA(Z)
+ K IBXDATA
+ S IBXNOREQ='$$REQ(2,"O",IBIFN)
+ Q
+ ;
+CIADDR(IBXDATA,IBXSAVE,LINE,FORM) ; Format current ins co address line LINE for FORM
+ ; FORM = 1 for CMS-1500, 2 for UB-04
+ ; Called from output formatter - both IBXDATA, IBXSAVE parameters are
+ ;  passed by reference
+ ;
+ K IBXDATA
+ I $G(FORM)'=1 D
+ . ;
+ . ; esg - 11/17/06 - IB*2*349 - UB-04 FL-38 contains the payer name
+ . ;       and address on 4 lines within this 5 line box.  All 5 lines
+ . ;       are formatted here into the IBXDATA array.  This is the
+ . ;       address that shows through the envelope window.
+ . ;
+ . N Z,LM,Q,ADDR,X
+ . S LM=$P($G(^IBE(350.9,1,1)),U,31)   ; UB address column parameter
+ . S Z=""
+ . I LM S $P(Z," ",LM)=""              ; beginning spaces indent
+ . S ADDR=$G(IBXSAVE("CADR"))          ; address data string
+ . S IBXDATA(1)="",Q=1                 ; line 1 is blank
+ . S Q=Q+1
+ . S IBXDATA(Q)=Z_$G(IBXSAVE("CADR_NAME"))     ; line 2 payer name
+ . S X=$P(ADDR,U,1)
+ . I X'="" S Q=Q+1,IBXDATA(Q)=Z_X              ; address line 1
+ . S X=$P(ADDR,U,2)
+ . I X'="" S Q=Q+1,IBXDATA(Q)=Z_X D            ; address line 2
+ .. S X=$P(ADDR,U,3)
+ .. I X'="" S IBXDATA(Q)=IBXDATA(Q)_" "_X      ; address line 3
+ .. Q
+ . S Q=Q+1                                     ; city,st,zip on last line
+ . S IBXDATA(Q)=Z_$P(ADDR,U,4)_", "_$$STATE^IBCEFG1($P(ADDR,U,5))_" "_$P(ADDR,U,6)
+ . KILL IBXSAVE("CADR_NAME"),IBXSAVE("CADR")   ; cleanup
+ . Q
+ ;
+ I $G(FORM)=1 D           ; CMS-1500
+ . N CT,X,Z
+ . S:'$D(IBXSAVE("INDENT")) Z="",$P(Z," ",+$P($G(^IBE(350.9,1,1)),U,27)+1)="",IBXSAVE("INDENT")=Z
+ . S CT=0
+ . S X=$P(IBXSAVE("CADR"),U) S:X'="" CT=CT+1,IBXDATA(CT)=IBXSAVE("INDENT")_X
+ . S X=$S($P(IBXSAVE("CADR"),U,2)'="":$P(IBXSAVE("CADR"),U,2),1:"")_$S($P(IBXSAVE("CADR"),U,2)'="":" ",1:"")_$P(IBXSAVE("CADR"),U,3) S:X'="" CT=CT+1,IBXDATA(CT)=IBXSAVE("INDENT")_X
+ . S CT=CT+1,IBXDATA(CT)=IBXSAVE("INDENT")_$P(IBXSAVE("CADR"),U,4)_", "_$$STATE^IBCEFG1($P(IBXSAVE("CADR"),U,5))_" "_$P(IBXSAVE("CADR"),U,6)
+ . Q
+ ;
+ Q
+ ;
