| 1 | IBJD1 ;ALB/MR - DIAGNOSTIC MEASURES UTILITIES ;16-DEC-00
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | VA(DFN) ; - Is patient a VA employee?
|
|---|
| 5 | ; Input: DFN - Pointer to the Patient file
|
|---|
| 6 | ; IBEXCEL - Optional global Variable (Print to an Excel format)
|
|---|
| 7 | ; Output: VAEMP - "E" (if IBEXCEL) or "*" - VA employee
|
|---|
| 8 | ;
|
|---|
| 9 | N ELMD,IEN,SSN,VADM,VAEMP
|
|---|
| 10 | S VAEMP="" G:'$G(DFN) VAQ
|
|---|
| 11 | D DEM^VADPT S SSN=+$P(VADM(2),"^") G:'SSN VAQ
|
|---|
| 12 | S IEN=+$O(^PRSPC("SSN",SSN,0)) G:'IEN VAQ
|
|---|
| 13 | I $P($G(^PRSPC(IEN,1)),U,33)'="Y" S VAEMP=$S($G(IBEXCEL):"E",1:"*")
|
|---|
| 14 | ;
|
|---|
| 15 | VAQ Q VAEMP
|
|---|
| 16 | ;
|
|---|
| 17 | PYMT(X) ; - Return most recent bill payment.
|
|---|
| 18 | ; Input: X=Bill pointer to file #399/#430
|
|---|
| 19 | ; Output: Y=Payment date in Fileman format ^ Payment amount
|
|---|
| 20 | ;
|
|---|
| 21 | N X1,X2,X3,Y S Y="" G:'$G(X) PAYQ
|
|---|
| 22 | S X1=9999999
|
|---|
| 23 | F S X1=$O(^PRCA(433,"C",X,X1),-1) Q:'X1 D Q:Y
|
|---|
| 24 | . S X2=$G(^PRCA(433,X1,0)),X3=$G(^PRCA(433,X1,1))
|
|---|
| 25 | . I $P(X2,U,4)'=2 Q ; Not complete.
|
|---|
| 26 | . I "^2^34^"'[(U_$P(X3,U,2)_U) Q ; Not a payment.
|
|---|
| 27 | . S Y=$S(X3:+X3,1:$P(X3,U,9)\1)_U_+$P(X3,U,5)
|
|---|
| 28 | PAYQ Q Y
|
|---|
| 29 | ;
|
|---|
| 30 | INS(DFN,DTE) ; return the Insurance Company for the Patient on DTE (date)
|
|---|
| 31 | ;
|
|---|
| 32 | N INS,POL,X,X0,Y
|
|---|
| 33 | S INS="",X=0
|
|---|
| 34 | F S X=$O(^DPT(DFN,.312,X)) Q:'X I $D(^(X,0)) D
|
|---|
| 35 | . S X0=^DPT(DFN,.312,X,0)
|
|---|
| 36 | . I '$$CHK^IBCNS1(X0,DTE) Q
|
|---|
| 37 | . S POL(0)=$G(POL(0))+1,POL(X,0)=X0
|
|---|
| 38 | ;
|
|---|
| 39 | I $G(POL(0))<1 G QINS
|
|---|
| 40 | I $G(POL(0))=1 S Y=+$O(POL(0))
|
|---|
| 41 | I $G(POL(0))>1 S Y=$$COB^IBCNS1(.POL)
|
|---|
| 42 | ;
|
|---|
| 43 | S INS=$P($G(^DIC(36,+POL(Y,0),0)),"^")
|
|---|
| 44 | ;
|
|---|
| 45 | QINS Q INS
|
|---|
| 46 | ;
|
|---|
| 47 | DIV(CLM) ; Returns the Medical Center Division for the Claim
|
|---|
| 48 | ; Input: CLM - Pointer to Claim Tracking File (#356)
|
|---|
| 49 | ;Output: DIVision for the Claim
|
|---|
| 50 | ;
|
|---|
| 51 | N ADM,DIV,ENC,PRSC,PRST,X
|
|---|
| 52 | ;
|
|---|
| 53 | S DIV=0,X=$G(^IBT(356,CLM,0))
|
|---|
| 54 | S ENC=+$P(X,"^",4) ; Encounter (Pointer to #409.68)
|
|---|
| 55 | S ADM=+$P(X,"^",5) ; Admission (Pointer to #405)
|
|---|
| 56 | ;
|
|---|
| 57 | ; Inpatient
|
|---|
| 58 | I ADM S DIV=+$P($G(^DIC(42,+$P($G(^DGPM(+$G(ADM),0)),U,6),0)),U,11)
|
|---|
| 59 | ;
|
|---|
| 60 | ; Outpatient
|
|---|
| 61 | I 'DIV,ENC S DIV=$P($$SCE^IBSDU(ENC),"^",11)
|
|---|
| 62 | ;
|
|---|
| 63 | ; If Pharmacy/Prosthetics or no Division found assume Primary Division
|
|---|
| 64 | QDIV S:'DIV DIV=$$PRIM^VASITE() S:DIV'>0 DIV=0
|
|---|
| 65 | Q DIV
|
|---|
| 66 | ;
|
|---|
| 67 | CATTYP(IBBCAT) ; - Break down AR Categories into First or Third party
|
|---|
| 68 | ;
|
|---|
| 69 | N IBFOTP,IBBTYP,IBCATDA0
|
|---|
| 70 | S IBFOTP="",IBBTYP=""
|
|---|
| 71 | I (IBBCAT>2&(IBBCAT<6))!(IBBCAT>23&(IBBCAT<27)) Q IBFOTP
|
|---|
| 72 | I '$D(^PRCA(430.2,IBBCAT,0)) Q IBFOTP
|
|---|
| 73 | S IBCATDA0=^PRCA(430.2,IBBCAT,0),IBBTYP=$P(IBCATDA0,"^",6)
|
|---|
| 74 | S IBFOTP=$S((IBBTYP="P")!(IBBTYP="C"):"F",1:"T")
|
|---|
| 75 | I IBBCAT=15 S IBFOTP="F" ; Exception:Ex-employee is first party
|
|---|
| 76 | I IBBCAT=16 S IBFOTP="F" ; Exception:Current Emp. is first party
|
|---|
| 77 | Q IBFOTP
|
|---|
