- IBJTU1 ;ALB/ARH - TPI UTILITIES ;2/14/95
- ;;2.0;INTEGRATED BILLING;**39,80,276,451,516,530,745**;21-MAR-94;Build 8
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- PRVSCR(SCRNARR) ; called as part of a screen ACTION PROTOCOL'S ENTRY ACTION to determine if screen has already been displayed
- ; returns true if screen array already exists (ie. already displayed),
- ; setting IBFASTXT causes LM to back out of current screens,
- ; setting IBPRVSCR causes LM to stop exiting screens when the chosen screen is reached
- ; if user tries to execute a screen already displayed it will quit out of existing screens until the asked for screen is found
- N X S X=0,IBPRVSCR="" I $G(SCRNARR)'="",$D(^TMP(SCRNARR,$J)) S X=1,IBPRVSCR=SCRNARR,IBFASTXT=3
- Q X
- ;
- HDR(IBIFN,DFN,LNS) ; called by a screens's LIST TEMPLATE HEADER to get lines for header, used for all TP screens
- ;input: LNS=header lines to add --- defined on exit: VALMHDR array
- ;
- N X,Y,Z,IBD0,IBPD0,IBDI1,IBCNT S IBIFN=+$G(IBIFN),DFN=+$G(DFN),LNS=+$G(LNS) K VALMHDR
- S IBCNT=0,IBD0=$G(^DGCR(399,+IBIFN,0)),IBPD0=$G(^DPT(+DFN,0))
- ;IB*2.0*516/TAZ - Call $$POLICY^IBCEF to insert HIPAA compliant fields into variable IBDI1. Data will
- ;continue to be extracted from IBDI1 original location.
- ;S IBDI1=$P(IBD0,U,21),IBDI1=$S(IBDI1="S":"I2",IBDI1="T":"I3",1:"I1"),IBDI1=$G(^DGCR(399,+IBIFN,IBDI1))
- S IBDI1=$P(IBD0,U,21),IBDI1=$$POLICY^IBCEF(IBIFN,,IBDI1) ; 516 - baa
- ;
- 1 I LNS'[1 G 2
- ; -- first line of screens: BILL NUMBER, PAT NAME, PAT ID, DOB, SUBSCRIBER ID
- N IBBILL,IBPAT,IBPATID,IBDOB,IBSUB,IBPNWDTH,REJFLG S IBCNT=IBCNT+1,(IBSUB,IBPATID)=""
- S IBBILL=$P(IBD0,U,1)_$$ECME^IBTRE(IBIFN)
- S X=$$PT^IBEFUNC(DFN),IBPAT=$P(X,U,1) ;I $P(X,U,3)'="" S IBPATID=$E(X)_$P(X,U,3) IB*2.0*745 - SSN Removal
- ;S X=$$PT^IBEFUNC(DFN),IBPAT=$P(X,U,1) I $P(X,U,3)'="" S IBPATID=$E(X)_$P(X,U,3) ;IB*2.0*745 - SSN Removal
- S IBDOB="DOB: "_$$DATE^IBJU1($P(IBPD0,U,3))
- I +IBIFN S X=$P(IBDI1,U,2),X=X_$J("",(13-$L(X))),IBSUB="Subsc ID: "_X
- ;
- ; IB*2.0*530 - Reject Indicator
- I ($G(NAME)="IBJT BILL CHARGES")!($G(NAME)="IBJT CLAIM INFO") S REJFLG=$S($$BILLREJ^IBJTU6($P(IBBILL,"e")):"c",1:"")
- ; IB*2.0*451 - get EEOB indicator for bill #
- S IBPFLAG=$$EEOB^IBJTLA1(IBIFN)
- S IBBILL=$G(IBPFLAG)_$G(REJFLG)_IBBILL
- S IBPNWDTH=80-($L(IBBILL)+3+2+$L(IBPATID)+3+$L(IBDOB)+3+$L(IBSUB)),IBPAT=$E(IBPAT,1,IBPNWDTH),Z=" "
- S VALMHDR(IBCNT)=IBBILL_Z_IBPAT_" "_IBPATID_$J("",(IBPNWDTH-$L(IBPAT)))_Z_IBDOB_Z_IBSUB
- ; IB*2.0*451 - add explanation of '%' indicator for the user
- S VALMSG="|% EEOB | Enter ?? for more actions|"
- 2 I LNS'[2 G 3
- ; -- bill screens line 2: STATEMENT DATES, TIMEFRAME, ORIG AMT (AR)
- N IBDU S IBCNT=IBCNT+1,IBDU=$G(^DGCR(399,+IBIFN,"U"))
- S X=" "_$$DATE^IBJU1(+IBDU)_" - "_$$DATE^IBJU1(+$P(IBDU,U,2)),VALMHDR(IBCNT)=X_$J("",(28-$L(X)))
- S X=$$EXSET^IBJU1(+$P(IBD0,U,6),399,.06),VALMHDR(IBCNT)=VALMHDR(IBCNT)_X_$J("",(29-$L(X)))
- S X=$$BILL^RCJIBFN2(IBIFN),X="Orig Amt: "_$FN($P(X,U,1),",",2),VALMHDR(IBCNT)=VALMHDR(IBCNT)_X
- ; IB*2.0*451 - add explanation of '%' indicator for the user
- S VALMSG="|% EEOB | Enter ?? for more actions|"
- 3 I LNS'[3 G HDRQ
- ; -- AR screens line 2: CURRENT STATUS (AR), ORIGINAL AMT (AR), CURRENT AMT (AR)
- N IBST,IBOC,IBBD,IBY S IBCNT=IBCNT+1,IBY=$$BILL^RCJIBFN2(+IBIFN)
- S IBST="AR Status: "_$P($$ARSTATA^IBJTU4(+IBIFN),U,1)
- S IBOC="Orig Amt: "_$FN($P(IBY,U,1),",",2)
- S IBBD="Balance Due: "_$FN($P(IBY,U,3),",",2)
- ;
- S X=" "_IBOC_$J("",(20-$L(IBOC)))_" "_IBBD_$J("",(23-$L(IBBD))),Y=80-$L(X),IBST=$E(IBST,1,Y)
- S VALMHDR(IBCNT)=IBST_$J("",(Y-$L(IBST)))_X
- ;
- HDRQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTU1 3632 printed Jan 18, 2025@03:25:24 Page 2
- IBJTU1 ;ALB/ARH - TPI UTILITIES ;2/14/95
- +1 ;;2.0;INTEGRATED BILLING;**39,80,276,451,516,530,745**;21-MAR-94;Build 8
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- PRVSCR(SCRNARR) ; called as part of a screen ACTION PROTOCOL'S ENTRY ACTION to determine if screen has already been displayed
- +1 ; returns true if screen array already exists (ie. already displayed),
- +2 ; setting IBFASTXT causes LM to back out of current screens,
- +3 ; setting IBPRVSCR causes LM to stop exiting screens when the chosen screen is reached
- +4 ; if user tries to execute a screen already displayed it will quit out of existing screens until the asked for screen is found
- +5 NEW X
- SET X=0
- SET IBPRVSCR=""
- IF $GET(SCRNARR)'=""
- IF $DATA(^TMP(SCRNARR,$JOB))
- SET X=1
- SET IBPRVSCR=SCRNARR
- SET IBFASTXT=3
- +6 QUIT X
- +7 ;
- HDR(IBIFN,DFN,LNS) ; called by a screens's LIST TEMPLATE HEADER to get lines for header, used for all TP screens
- +1 ;input: LNS=header lines to add --- defined on exit: VALMHDR array
- +2 ;
- +3 NEW X,Y,Z,IBD0,IBPD0,IBDI1,IBCNT
- SET IBIFN=+$GET(IBIFN)
- SET DFN=+$GET(DFN)
- SET LNS=+$GET(LNS)
- KILL VALMHDR
- +4 SET IBCNT=0
- SET IBD0=$GET(^DGCR(399,+IBIFN,0))
- SET IBPD0=$GET(^DPT(+DFN,0))
- +5 ;IB*2.0*516/TAZ - Call $$POLICY^IBCEF to insert HIPAA compliant fields into variable IBDI1. Data will
- +6 ;continue to be extracted from IBDI1 original location.
- +7 ;S IBDI1=$P(IBD0,U,21),IBDI1=$S(IBDI1="S":"I2",IBDI1="T":"I3",1:"I1"),IBDI1=$G(^DGCR(399,+IBIFN,IBDI1))
- +8 ; 516 - baa
- SET IBDI1=$PIECE(IBD0,U,21)
- SET IBDI1=$$POLICY^IBCEF(IBIFN,,IBDI1)
- +9 ;
- 1 IF LNS'[1
- GOTO 2
- +1 ; -- first line of screens: BILL NUMBER, PAT NAME, PAT ID, DOB, SUBSCRIBER ID
- +2 NEW IBBILL,IBPAT,IBPATID,IBDOB,IBSUB,IBPNWDTH,REJFLG
- SET IBCNT=IBCNT+1
- SET (IBSUB,IBPATID)=""
- +3 SET IBBILL=$PIECE(IBD0,U,1)_$$ECME^IBTRE(IBIFN)
- +4 ;I $P(X,U,3)'="" S IBPATID=$E(X)_$P(X,U,3) IB*2.0*745 - SSN Removal
- SET X=$$PT^IBEFUNC(DFN)
- SET IBPAT=$PIECE(X,U,1)
- +5 ;S X=$$PT^IBEFUNC(DFN),IBPAT=$P(X,U,1) I $P(X,U,3)'="" S IBPATID=$E(X)_$P(X,U,3) ;IB*2.0*745 - SSN Removal
- +6 SET IBDOB="DOB: "_$$DATE^IBJU1($PIECE(IBPD0,U,3))
- +7 IF +IBIFN
- SET X=$PIECE(IBDI1,U,2)
- SET X=X_$JUSTIFY("",(13-$LENGTH(X)))
- SET IBSUB="Subsc ID: "_X
- +8 ;
- +9 ; IB*2.0*530 - Reject Indicator
- +10 IF ($GET(NAME)="IBJT BILL CHARGES")!($GET(NAME)="IBJT CLAIM INFO")
- SET REJFLG=$SELECT($$BILLREJ^IBJTU6($PIECE(IBBILL,"e")):"c",1:"")
- +11 ; IB*2.0*451 - get EEOB indicator for bill #
- +12 SET IBPFLAG=$$EEOB^IBJTLA1(IBIFN)
- +13 SET IBBILL=$GET(IBPFLAG)_$GET(REJFLG)_IBBILL
- +14 SET IBPNWDTH=80-($LENGTH(IBBILL)+3+2+$LENGTH(IBPATID)+3+$LENGTH(IBDOB)+3+$LENGTH(IBSUB))
- SET IBPAT=$EXTRACT(IBPAT,1,IBPNWDTH)
- SET Z=" "
- +15 SET VALMHDR(IBCNT)=IBBILL_Z_IBPAT_" "_IBPATID_$JUSTIFY("",(IBPNWDTH-$LENGTH(IBPAT)))_Z_IBDOB_Z_IBSUB
- +16 ; IB*2.0*451 - add explanation of '%' indicator for the user
- +17 SET VALMSG="|% EEOB | Enter ?? for more actions|"
- 2 IF LNS'[2
- GOTO 3
- +1 ; -- bill screens line 2: STATEMENT DATES, TIMEFRAME, ORIG AMT (AR)
- +2 NEW IBDU
- SET IBCNT=IBCNT+1
- SET IBDU=$GET(^DGCR(399,+IBIFN,"U"))
- +3 SET X=" "_$$DATE^IBJU1(+IBDU)_" - "_$$DATE^IBJU1(+$PIECE(IBDU,U,2))
- SET VALMHDR(IBCNT)=X_$JUSTIFY("",(28-$LENGTH(X)))
- +4 SET X=$$EXSET^IBJU1(+$PIECE(IBD0,U,6),399,.06)
- SET VALMHDR(IBCNT)=VALMHDR(IBCNT)_X_$JUSTIFY("",(29-$LENGTH(X)))
- +5 SET X=$$BILL^RCJIBFN2(IBIFN)
- SET X="Orig Amt: "_$FNUMBER($PIECE(X,U,1),",",2)
- SET VALMHDR(IBCNT)=VALMHDR(IBCNT)_X
- +6 ; IB*2.0*451 - add explanation of '%' indicator for the user
- +7 SET VALMSG="|% EEOB | Enter ?? for more actions|"
- 3 IF LNS'[3
- GOTO HDRQ
- +1 ; -- AR screens line 2: CURRENT STATUS (AR), ORIGINAL AMT (AR), CURRENT AMT (AR)
- +2 NEW IBST,IBOC,IBBD,IBY
- SET IBCNT=IBCNT+1
- SET IBY=$$BILL^RCJIBFN2(+IBIFN)
- +3 SET IBST="AR Status: "_$PIECE($$ARSTATA^IBJTU4(+IBIFN),U,1)
- +4 SET IBOC="Orig Amt: "_$FNUMBER($PIECE(IBY,U,1),",",2)
- +5 SET IBBD="Balance Due: "_$FNUMBER($PIECE(IBY,U,3),",",2)
- +6 ;
- +7 SET X=" "_IBOC_$JUSTIFY("",(20-$LENGTH(IBOC)))_" "_IBBD_$JUSTIFY("",(23-$LENGTH(IBBD)))
- SET Y=80-$LENGTH(X)
- SET IBST=$EXTRACT(IBST,1,Y)
- +8 SET VALMHDR(IBCNT)=IBST_$JUSTIFY("",(Y-$LENGTH(IBST)))_X
- +9 ;
- HDRQ QUIT