- IBJD1 ;ALB/MR - DIAGNOSTIC MEASURES UTILITIES ;16-DEC-00
- ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
- ;
- VA(DFN) ; - Is patient a VA employee?
- ; Input: DFN - Pointer to the Patient file
- ; IBEXCEL - Optional global Variable (Print to an Excel format)
- ; Output: VAEMP - "E" (if IBEXCEL) or "*" - VA employee
- ;
- N ELMD,IEN,SSN,VADM,VAEMP
- S VAEMP="" G:'$G(DFN) VAQ
- D DEM^VADPT S SSN=+$P(VADM(2),"^") G:'SSN VAQ
- S IEN=+$O(^PRSPC("SSN",SSN,0)) G:'IEN VAQ
- I $P($G(^PRSPC(IEN,1)),U,33)'="Y" S VAEMP=$S($G(IBEXCEL):"E",1:"*")
- ;
- VAQ Q VAEMP
- ;
- PYMT(X) ; - Return most recent bill payment.
- ; Input: X=Bill pointer to file #399/#430
- ; Output: Y=Payment date in Fileman format ^ Payment amount
- ;
- N X1,X2,X3,Y S Y="" G:'$G(X) PAYQ
- S X1=9999999
- F S X1=$O(^PRCA(433,"C",X,X1),-1) Q:'X1 D Q:Y
- . S X2=$G(^PRCA(433,X1,0)),X3=$G(^PRCA(433,X1,1))
- . I $P(X2,U,4)'=2 Q ; Not complete.
- . I "^2^34^"'[(U_$P(X3,U,2)_U) Q ; Not a payment.
- . S Y=$S(X3:+X3,1:$P(X3,U,9)\1)_U_+$P(X3,U,5)
- PAYQ Q Y
- ;
- INS(DFN,DTE) ; return the Insurance Company for the Patient on DTE (date)
- ;
- N INS,POL,X,X0,Y
- S INS="",X=0
- F S X=$O(^DPT(DFN,.312,X)) Q:'X I $D(^(X,0)) D
- . S X0=^DPT(DFN,.312,X,0)
- . I '$$CHK^IBCNS1(X0,DTE) Q
- . S POL(0)=$G(POL(0))+1,POL(X,0)=X0
- ;
- I $G(POL(0))<1 G QINS
- I $G(POL(0))=1 S Y=+$O(POL(0))
- I $G(POL(0))>1 S Y=$$COB^IBCNS1(.POL)
- ;
- S INS=$P($G(^DIC(36,+POL(Y,0),0)),"^")
- ;
- QINS Q INS
- ;
- DIV(CLM) ; Returns the Medical Center Division for the Claim
- ; Input: CLM - Pointer to Claim Tracking File (#356)
- ;Output: DIVision for the Claim
- ;
- N ADM,DIV,ENC,PRSC,PRST,X
- ;
- S DIV=0,X=$G(^IBT(356,CLM,0))
- S ENC=+$P(X,"^",4) ; Encounter (Pointer to #409.68)
- S ADM=+$P(X,"^",5) ; Admission (Pointer to #405)
- ;
- ; Inpatient
- I ADM S DIV=+$P($G(^DIC(42,+$P($G(^DGPM(+$G(ADM),0)),U,6),0)),U,11)
- ;
- ; Outpatient
- I 'DIV,ENC S DIV=$P($$SCE^IBSDU(ENC),"^",11)
- ;
- ; If Pharmacy/Prosthetics or no Division found assume Primary Division
- QDIV S:'DIV DIV=$$PRIM^VASITE() S:DIV'>0 DIV=0
- Q DIV
- ;
- CATTYP(IBBCAT) ; - Break down AR Categories into First or Third party
- ;
- N IBFOTP,IBBTYP,IBCATDA0
- S IBFOTP="",IBBTYP=""
- I (IBBCAT>2&(IBBCAT<6))!(IBBCAT>23&(IBBCAT<27)) Q IBFOTP
- I '$D(^PRCA(430.2,IBBCAT,0)) Q IBFOTP
- S IBCATDA0=^PRCA(430.2,IBBCAT,0),IBBTYP=$P(IBCATDA0,"^",6)
- S IBFOTP=$S((IBBTYP="P")!(IBBTYP="C"):"F",1:"T")
- I IBBCAT=15 S IBFOTP="F" ; Exception:Ex-employee is first party
- I IBBCAT=16 S IBFOTP="F" ; Exception:Current Emp. is first party
- Q IBFOTP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJD1 2595 printed Feb 18, 2025@23:48:57 Page 2
- IBJD1 ;ALB/MR - DIAGNOSTIC MEASURES UTILITIES ;16-DEC-00
- +1 ;;2.0;INTEGRATED BILLING;**123,159**;21-MAR-94
- +2 ;
- VA(DFN) ; - Is patient a VA employee?
- +1 ; Input: DFN - Pointer to the Patient file
- +2 ; IBEXCEL - Optional global Variable (Print to an Excel format)
- +3 ; Output: VAEMP - "E" (if IBEXCEL) or "*" - VA employee
- +4 ;
- +5 NEW ELMD,IEN,SSN,VADM,VAEMP
- +6 SET VAEMP=""
- if '$GET(DFN)
- GOTO VAQ
- +7 DO DEM^VADPT
- SET SSN=+$PIECE(VADM(2),"^")
- if 'SSN
- GOTO VAQ
- +8 SET IEN=+$ORDER(^PRSPC("SSN",SSN,0))
- if 'IEN
- GOTO VAQ
- +9 IF $PIECE($GET(^PRSPC(IEN,1)),U,33)'="Y"
- SET VAEMP=$SELECT($GET(IBEXCEL):"E",1:"*")
- +10 ;
- VAQ QUIT VAEMP
- +1 ;
- PYMT(X) ; - Return most recent bill payment.
- +1 ; Input: X=Bill pointer to file #399/#430
- +2 ; Output: Y=Payment date in Fileman format ^ Payment amount
- +3 ;
- +4 NEW X1,X2,X3,Y
- SET Y=""
- if '$GET(X)
- GOTO PAYQ
- +5 SET X1=9999999
- +6 FOR
- SET X1=$ORDER(^PRCA(433,"C",X,X1),-1)
- if 'X1
- QUIT
- Begin DoDot:1
- +7 SET X2=$GET(^PRCA(433,X1,0))
- SET X3=$GET(^PRCA(433,X1,1))
- +8 ; Not complete.
- IF $PIECE(X2,U,4)'=2
- QUIT
- +9 ; Not a payment.
- IF "^2^34^"'[(U_$PIECE(X3,U,2)_U)
- QUIT
- +10 SET Y=$SELECT(X3:+X3,1:$PIECE(X3,U,9)\1)_U_+$PIECE(X3,U,5)
- End DoDot:1
- if Y
- QUIT
- PAYQ QUIT Y
- +1 ;
- INS(DFN,DTE) ; return the Insurance Company for the Patient on DTE (date)
- +1 ;
- +2 NEW INS,POL,X,X0,Y
- +3 SET INS=""
- SET X=0
- +4 FOR
- SET X=$ORDER(^DPT(DFN,.312,X))
- if 'X
- QUIT
- IF $DATA(^(X,0))
- Begin DoDot:1
- +5 SET X0=^DPT(DFN,.312,X,0)
- +6 IF '$$CHK^IBCNS1(X0,DTE)
- QUIT
- +7 SET POL(0)=$GET(POL(0))+1
- SET POL(X,0)=X0
- End DoDot:1
- +8 ;
- +9 IF $GET(POL(0))<1
- GOTO QINS
- +10 IF $GET(POL(0))=1
- SET Y=+$ORDER(POL(0))
- +11 IF $GET(POL(0))>1
- SET Y=$$COB^IBCNS1(.POL)
- +12 ;
- +13 SET INS=$PIECE($GET(^DIC(36,+POL(Y,0),0)),"^")
- +14 ;
- QINS QUIT INS
- +1 ;
- DIV(CLM) ; Returns the Medical Center Division for the Claim
- +1 ; Input: CLM - Pointer to Claim Tracking File (#356)
- +2 ;Output: DIVision for the Claim
- +3 ;
- +4 NEW ADM,DIV,ENC,PRSC,PRST,X
- +5 ;
- +6 SET DIV=0
- SET X=$GET(^IBT(356,CLM,0))
- +7 ; Encounter (Pointer to #409.68)
- SET ENC=+$PIECE(X,"^",4)
- +8 ; Admission (Pointer to #405)
- SET ADM=+$PIECE(X,"^",5)
- +9 ;
- +10 ; Inpatient
- +11 IF ADM
- SET DIV=+$PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(+$GET(ADM),0)),U,6),0)),U,11)
- +12 ;
- +13 ; Outpatient
- +14 IF 'DIV
- IF ENC
- SET DIV=$PIECE($$SCE^IBSDU(ENC),"^",11)
- +15 ;
- +16 ; If Pharmacy/Prosthetics or no Division found assume Primary Division
- QDIV if 'DIV
- SET DIV=$$PRIM^VASITE()
- if DIV'>0
- SET DIV=0
- +1 QUIT DIV
- +2 ;
- CATTYP(IBBCAT) ; - Break down AR Categories into First or Third party
- +1 ;
- +2 NEW IBFOTP,IBBTYP,IBCATDA0
- +3 SET IBFOTP=""
- SET IBBTYP=""
- +4 IF (IBBCAT>2&(IBBCAT<6))!(IBBCAT>23&(IBBCAT<27))
- QUIT IBFOTP
- +5 IF '$DATA(^PRCA(430.2,IBBCAT,0))
- QUIT IBFOTP
- +6 SET IBCATDA0=^PRCA(430.2,IBBCAT,0)
- SET IBBTYP=$PIECE(IBCATDA0,"^",6)
- +7 SET IBFOTP=$SELECT((IBBTYP="P")!(IBBTYP="C"):"F",1:"T")
- +8 ; Exception:Ex-employee is first party
- IF IBBCAT=15
- SET IBFOTP="F"
- +9 ; Exception:Current Emp. is first party
- IF IBBCAT=16
- SET IBFOTP="F"
- +10 QUIT IBFOTP
