- IBCU ;ALB/MRL - BILLING UTILITY ROUTINE ;01 JUN 88 12:00
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;MAP TO DGCRU
- ;
- ARSTAT ;find status of bill in file 430.3 (ar) return status number
- S IBARST=$$STA^PRCAFN(IBIFN)
- Q
- ;
- ARCAT ;Trigger logic to set who's responsible in 399.3 from AR Category
- S X=$P($$CATN^PRCAFN($P(^DGCR(399.3,DA,0),"^",6)),"^",3)
- S:X'="" X=$S("PC"[X:"p",X="N":"o",X="T":"i",1:"")
- Q
- ;
- PTF ;Screen for appropriate PTF records
- K IBDD1 S DFN=+$P(^DGCR(399,+DA,0),"^",2) Q:'$D(^DPT(+DFN,0)) S IB05=$P(^(0),"^",1),IB03=$P(^DGCR(399,+DA,0),"^",3)
- S IB01="",IB02=0 F IB02=0:0 S IB01=$O(^DD(45,0,"ID",IB01)) Q:'IB01 S IB02=IB02+1,IBDD(IB02)=^(IB01)
- F IB01=0:0 S IB01=$O(^DGPT("B",+DFN,IB01)) Q:'IB01 I $D(^DGPT(+IB01,0)) S IB04=$P(^(0),"^",2),Y=+IB01 I $P(IB03,".",1)=$P(IB04,".",1) S IBDD1(+Y)="" I $S('$D(X):0,X["?":1,1:0) D PTFW
- G PTFQ:X'["?" I '$O(IBDD1(0)) W !,"Patient has no ACTIVE PTF RECORDS for this event date.",!,"A 'PTF NUMBER' is required for inpatient billing records."
- E W !!,"Select the appropriate billing record from the above listing by number."
- PTFQ W ! K IB01,IB02,IB03,IB04,IB05,IBDD Q
- PTFW W !,Y,?15,IB05 F IB02=0:0 S IB02=$O(IBDD(IB02)) Q:'IB02 X IBDD(IB02)
- Q
- ;
- AGE ;Input Transform for Condition Code 17
- I X=18 G SEX
- I X=17 S IBC=X,DFN=$P(^DGCR(399,D0,0),"^",2) D DEM^VADPT I VADM(4)<100 W !!,"This patient is only ",VADM(4)," years old!!",!! K IBC Q
- I $D(IBC) S X=IBC
- Q
- ;
- SEX ;Input Transform for Condition Code 18
- I X=18 S IBC=X,DFN=$P(^DGCR(399,D0,0),"^",2) D DEM^VADPT I $E(VADM(5))="M" W !!,"This patient is a MALE!! Condition code 18 applies only to FEMALES!!",!! K IBC,X
- I $D(IBC) S X=IBC
- Q
- ;
- REV ;Input Transform for Revenue Code
- I X=-1 W !!,"Choose only ACTIVE Revenue Codes!!",!! S D="AC" ;S X="" S X=$O(^DGCR(399.2,"AC",X)) Q:X="" W !,$P(^DGCR(399.2,X,0),"^",1),?30,$P(^(0),"^",2) K X Q
- I '$D(IBC) I $D(^DGCR(399.2,X,0)) I '$P(^DGCR(399.2,X,0),"^",3) W !!,"Only ACTIVE Revenue Codes may be selected!!",!! K X Q
- Q
- ;
- YN S X=$E(X),X=$S(X=1:X,X=0:X,X="Y":1,X="y":1,X="n":0,X="N":0,1:2) I X'=2 W " (",$S(X:"YES",1:"NO"),")" Q
- W !?4,"NOT A VALID CHOICE!",*7 K X Q
- Q
- ;
- DIS ;Determine Billing Discharge status from PTF
- ;Called from triggers on fields .08 and 161
- N A
- I '$D(^DGCR(399,DA,0)) S X="" G DISQ
- S X=$P(^DGCR(399,DA,0),"^",6) I X=2!(X=3) S X=$O(^DGCR(399.1,"B","STILL PATIENT",0)) G DISQ
- S X=$P(^DGCR(399,DA,0),"^",8) I $S(X="":1,'$D(^DGPT(X)):1,1:0) S X="" G DISQ
- I '+$G(^DGPT(X,70)) S X=$O(^DGCR(399.1,"B","STILL PATIENT",0)) G DISQ
- S A=$P($G(^DGCR(399,DA,"U")),"^",2) I A,(A+.24)<+$G(^DGPT(X,70)) S X=$O(^DGCR(399.1,"B","STILL PATIENT",0)) G DISQ
- S X=+$P($G(^DGPT(X,70)),"^",3)
- I X=1 S X=$O(^DGCR(399.1,"B",$E("DISCHARGED TO HOME OR SELF CARE",1,30),0)) G DISQ
- I X=4 S X=$O(^DGCR(399.1,"B",$E("LEFT AGAINST MEDICAL ADVICE",1,30),0)) G DISQ
- I X=6!(X=7) S X=$O(^DGCR(399.1,"B","EXPIRED",0)) G DISQ
- I X=5!(X=2) S X=$O(^DGCR(399.1,"B",$E("DISCHARGED TO ANOTHER SHORT-TERM GENERAL HOSPITAL",1,30),0)) G DISQ
- S X=""
- DISQ Q
- ;
- INST ;Ask Institutution address info
- S DIC("DR")="1.01;1.02;1.03;.02;1.04" I $D(^XUSEC("IB SUPERVISOR",DUZ)) S DLAYGO=4
- Q
- ;
- SM ;Flag for printing medicare statment on UB-82
- ;DGSM=0 means figure out which statement, DGSM=1 means no statements
- S DGSM=0 Q
- ;IBCU
- IBCU ;ALB/MRL - BILLING UTILITY ROUTINE ;01 JUN 88 12:00
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRU
- +5 ;
- ARSTAT ;find status of bill in file 430.3 (ar) return status number
- +1 SET IBARST=$$STA^PRCAFN(IBIFN)
- +2 QUIT
- +3 ;
- ARCAT ;Trigger logic to set who's responsible in 399.3 from AR Category
- +1 SET X=$PIECE($$CATN^PRCAFN($PIECE(^DGCR(399.3,DA,0),"^",6)),"^",3)
- +2 IF X'=""
- SET X=$SELECT("PC"[X:"p",X="N":"o",X="T":"i",1:"")
- +3 QUIT
- +4 ;
- PTF ;Screen for appropriate PTF records
- +1 KILL IBDD1
- SET DFN=+$PIECE(^DGCR(399,+DA,0),"^",2)
- IF '$DATA(^DPT(+DFN,0))
- QUIT
- SET IB05=$PIECE(^(0),"^",1)
- SET IB03=$PIECE(^DGCR(399,+DA,0),"^",3)
- +2 SET IB01=""
- SET IB02=0
- FOR IB02=0:0
- SET IB01=$ORDER(^DD(45,0,"ID",IB01))
- IF 'IB01
- QUIT
- SET IB02=IB02+1
- SET IBDD(IB02)=^(IB01)
- +3 FOR IB01=0:0
- SET IB01=$ORDER(^DGPT("B",+DFN,IB01))
- IF 'IB01
- QUIT
- IF $DATA(^DGPT(+IB01,0))
- SET IB04=$PIECE(^(0),"^",2)
- SET Y=+IB01
- IF $PIECE(IB03,".",1)=$PIECE(IB04,".",1)
- SET IBDD1(+Y)=""
- IF $SELECT('$DATA(X):0,X["?":1,1:0)
- DO PTFW
- +4 IF X'["?"
- GOTO PTFQ
- IF '$ORDER(IBDD1(0))
- WRITE !,"Patient has no ACTIVE PTF RECORDS for this event date.",!,"A 'PTF NUMBER' is required for inpatient billing records."
- +5 IF '$TEST
- WRITE !!,"Select the appropriate billing record from the above listing by number."
- PTFQ WRITE !
- KILL IB01,IB02,IB03,IB04,IB05,IBDD
- QUIT
- PTFW WRITE !,Y,?15,IB05
- FOR IB02=0:0
- SET IB02=$ORDER(IBDD(IB02))
- IF 'IB02
- QUIT
- XECUTE IBDD(IB02)
- +1 QUIT
- +2 ;
- AGE ;Input Transform for Condition Code 17
- +1 IF X=18
- GOTO SEX
- +2 IF X=17
- SET IBC=X
- SET DFN=$PIECE(^DGCR(399,D0,0),"^",2)
- DO DEM^VADPT
- IF VADM(4)<100
- WRITE !!,"This patient is only ",VADM(4)," years old!!",!!
- KILL IBC
- QUIT
- +3 IF $DATA(IBC)
- SET X=IBC
- +4 QUIT
- +5 ;
- SEX ;Input Transform for Condition Code 18
- +1 IF X=18
- SET IBC=X
- SET DFN=$PIECE(^DGCR(399,D0,0),"^",2)
- DO DEM^VADPT
- IF $EXTRACT(VADM(5))="M"
- WRITE !!,"This patient is a MALE!! Condition code 18 applies only to FEMALES!!",!!
- KILL IBC,X
- +2 IF $DATA(IBC)
- SET X=IBC
- +3 QUIT
- +4 ;
- REV ;Input Transform for Revenue Code
- +1 ;S X="" S X=$O(^DGCR(399.2,"AC",X)) Q:X="" W !,$P(^DGCR(399.2,X,0),"^",1),?30,$P(^(0),"^",2) K X Q
- IF X=-1
- WRITE !!,"Choose only ACTIVE Revenue Codes!!",!!
- SET D="AC"
- +2 IF '$DATA(IBC)
- IF $DATA(^DGCR(399.2,X,0))
- IF '$PIECE(^DGCR(399.2,X,0),"^",3)
- WRITE !!,"Only ACTIVE Revenue Codes may be selected!!",!!
- KILL X
- QUIT
- +3 QUIT
- +4 ;
- YN SET X=$EXTRACT(X)
- SET X=$SELECT(X=1:X,X=0:X,X="Y":1,X="y":1,X="n":0,X="N":0,1:2)
- IF X'=2
- WRITE " (",$SELECT(X:"YES",1:"NO"),")"
- QUIT
- +1 WRITE !?4,"NOT A VALID CHOICE!",*7
- KILL X
- QUIT
- +2 QUIT
- +3 ;
- DIS ;Determine Billing Discharge status from PTF
- +1 ;Called from triggers on fields .08 and 161
- +2 NEW A
- +3 IF '$DATA(^DGCR(399,DA,0))
- SET X=""
- GOTO DISQ
- +4 SET X=$PIECE(^DGCR(399,DA,0),"^",6)
- IF X=2!(X=3)
- SET X=$ORDER(^DGCR(399.1,"B","STILL PATIENT",0))
- GOTO DISQ
- +5 SET X=$PIECE(^DGCR(399,DA,0),"^",8)
- IF $SELECT(X="":1,'$DATA(^DGPT(X)):1,1:0)
- SET X=""
- GOTO DISQ
- +6 IF '+$GET(^DGPT(X,70))
- SET X=$ORDER(^DGCR(399.1,"B","STILL PATIENT",0))
- GOTO DISQ
- +7 SET A=$PIECE($GET(^DGCR(399,DA,"U")),"^",2)
- IF A
- IF (A+.24)<+$GET(^DGPT(X,70))
- SET X=$ORDER(^DGCR(399.1,"B","STILL PATIENT",0))
- GOTO DISQ
- +8 SET X=+$PIECE($GET(^DGPT(X,70)),"^",3)
- +9 IF X=1
- SET X=$ORDER(^DGCR(399.1,"B",$EXTRACT("DISCHARGED TO HOME OR SELF CARE",1,30),0))
- GOTO DISQ
- +10 IF X=4
- SET X=$ORDER(^DGCR(399.1,"B",$EXTRACT("LEFT AGAINST MEDICAL ADVICE",1,30),0))
- GOTO DISQ
- +11 IF X=6!(X=7)
- SET X=$ORDER(^DGCR(399.1,"B","EXPIRED",0))
- GOTO DISQ
- +12 IF X=5!(X=2)
- SET X=$ORDER(^DGCR(399.1,"B",$EXTRACT("DISCHARGED TO ANOTHER SHORT-TERM GENERAL HOSPITAL",1,30),0))
- GOTO DISQ
- +13 SET X=""
- DISQ QUIT
- +1 ;
- INST ;Ask Institutution address info
- +1 SET DIC("DR")="1.01;1.02;1.03;.02;1.04"
- IF $DATA(^XUSEC("IB SUPERVISOR",DUZ))
- SET DLAYGO=4
- +2 QUIT
- +3 ;
- SM ;Flag for printing medicare statment on UB-82
- +1 ;DGSM=0 means figure out which statement, DGSM=1 means no statements
- +2 SET DGSM=0
- QUIT
- +3 ;IBCU
