| 1 | IBJTU1 ;ALB/ARH - TPI UTILITIES ;2/14/95
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**39,80,276**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | PRVSCR(SCRNARR) ; called as part of a screen ACTION PROTOCOL'S ENTRY ACTION to determine if screen has already been displayed
|
|---|
| 6 | ; returns true if screen array already exists (ie. already displayed),
|
|---|
| 7 | ; setting IBFASTXT causes LM to back out of current screens,
|
|---|
| 8 | ; setting IBPRVSCR causes LM to stop exiting screens when the chosen screen is reached
|
|---|
| 9 | ; if user tries to execute a screen already displayed it will quit out of existing screens until the asked for screen is found
|
|---|
| 10 | N X S X=0,IBPRVSCR="" I $G(SCRNARR)'="",$D(^TMP(SCRNARR,$J)) S X=1,IBPRVSCR=SCRNARR,IBFASTXT=3
|
|---|
| 11 | Q X
|
|---|
| 12 | ;
|
|---|
| 13 | HDR(IBIFN,DFN,LNS) ; called by a screens's LIST TEMPLATE HEADER to get lines for header, used for all TP screens
|
|---|
| 14 | ;input: LNS=header lines to add --- defined on exit: VALMHDR array
|
|---|
| 15 | ;
|
|---|
| 16 | N X,Y,Z,IBD0,IBPD0,IBDI1,IBCNT S IBIFN=+$G(IBIFN),DFN=+$G(DFN),LNS=+$G(LNS) K VALMHDR
|
|---|
| 17 | S IBCNT=0,IBD0=$G(^DGCR(399,+IBIFN,0)),IBPD0=$G(^DPT(+DFN,0))
|
|---|
| 18 | S IBDI1=$P(IBD0,U,21),IBDI1=$S(IBDI1="S":"I2",IBDI1="T":"I3",1:"I1"),IBDI1=$G(^DGCR(399,+IBIFN,IBDI1))
|
|---|
| 19 | ;
|
|---|
| 20 | 1 I LNS'[1 G 2
|
|---|
| 21 | ; -- first line of screens: BILL NUMBER, PAT NAME, PAT ID, DOB, SUBSCRIBER ID
|
|---|
| 22 | N IBBILL,IBPAT,IBPATID,IBDOB,IBSUB,IBPNWDTH S IBCNT=IBCNT+1,(IBSUB,IBPATID)=""
|
|---|
| 23 | S IBBILL=$P(IBD0,U,1)_$$ECME^IBTRE(IBIFN)
|
|---|
| 24 | S X=$$PT^IBEFUNC(DFN),IBPAT=$P(X,U,1) I $P(X,U,3)'="" S IBPATID=$E(X)_$P(X,U,3)
|
|---|
| 25 | S IBDOB="DOB: "_$$DATE^IBJU1($P(IBPD0,U,3))
|
|---|
| 26 | I +IBIFN S X=$P(IBDI1,U,2),X=X_$J("",(13-$L(X))),IBSUB="Subsc ID: "_X
|
|---|
| 27 | ;
|
|---|
| 28 | S IBPNWDTH=80-($L(IBBILL)+3+2+$L(IBPATID)+3+$L(IBDOB)+3+$L(IBSUB)),IBPAT=$E(IBPAT,1,IBPNWDTH),Z=" "
|
|---|
| 29 | S VALMHDR(IBCNT)=IBBILL_Z_IBPAT_" "_IBPATID_$J("",(IBPNWDTH-$L(IBPAT)))_Z_IBDOB_Z_IBSUB
|
|---|
| 30 | ;
|
|---|
| 31 | 2 I LNS'[2 G 3
|
|---|
| 32 | ; -- bill screens line 2: STATEMENT DATES, TIMEFRAME, ORIG AMT (AR)
|
|---|
| 33 | N IBDU S IBCNT=IBCNT+1,IBDU=$G(^DGCR(399,+IBIFN,"U"))
|
|---|
| 34 | S X=" "_$$DATE^IBJU1(+IBDU)_" - "_$$DATE^IBJU1(+$P(IBDU,U,2)),VALMHDR(IBCNT)=X_$J("",(28-$L(X)))
|
|---|
| 35 | S X=$$EXSET^IBJU1(+$P(IBD0,U,6),399,.06),VALMHDR(IBCNT)=VALMHDR(IBCNT)_X_$J("",(29-$L(X)))
|
|---|
| 36 | S X=$$BILL^RCJIBFN2(IBIFN),X="Orig Amt: "_$FN($P(X,U,1),",",2),VALMHDR(IBCNT)=VALMHDR(IBCNT)_X
|
|---|
| 37 | ;
|
|---|
| 38 | 3 I LNS'[3 G HDRQ
|
|---|
| 39 | ; -- AR screens line 2: CURRENT STATUS (AR), ORIGINAL AMT (AR), CURRENT AMT (AR)
|
|---|
| 40 | N IBST,IBOC,IBBD,IBY S IBCNT=IBCNT+1,IBY=$$BILL^RCJIBFN2(+IBIFN)
|
|---|
| 41 | S IBST="AR Status: "_$P($$ARSTATA^IBJTU4(+IBIFN),U,1)
|
|---|
| 42 | S IBOC="Orig Amt: "_$FN($P(IBY,U,1),",",2)
|
|---|
| 43 | S IBBD="Balance Due: "_$FN($P(IBY,U,3),",",2)
|
|---|
| 44 | ;
|
|---|
| 45 | S X=" "_IBOC_$J("",(20-$L(IBOC)))_" "_IBBD_$J("",(23-$L(IBBD))),Y=80-$L(X),IBST=$E(IBST,1,Y)
|
|---|
| 46 | S VALMHDR(IBCNT)=IBST_$J("",(Y-$L(IBST)))_X
|
|---|
| 47 | ;
|
|---|
| 48 | HDRQ Q
|
|---|
