IBJTTA1 ;ALB/ARH - TPI AR ACCOUNT/CLAIM PROFILE BUILD ; 06-MAR-1995
;;2.0;INTEGRATED BILLING;**39,609**;21-MAR-94;Build 26
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
BLD ;
N X,IBY,IBS,IBI,IBD0,IBDS,IBDU1,IBCNT,IBLN,IBAR
S IBD0=$G(^DGCR(399,+IBIFN,0)),IBDS=$G(^DGCR(399,+IBIFN,"S")),IBDU1=$G(^DGCR(399,+IBIFN,"U1"))
S IBAR=$$BILL^RCJIBFN2(IBIFN)
;
S VALMCNT=0,IBCNT=0,X=""
;
; original bill
;
S IBS=$P(IBD0,U,13),(IBI,IBY)="" D
. I IBS=1 S IBI="ENTERED",IBY=$P(IBDS,U,1) Q
. I IBS=2 S IBI="REVIEWED",IBY=$P(IBDS,U,4) S:$P(IBDS,U,7)>IBY IBI="REVIEWED (2nd)",IBY=$P(IBDS,U,7) Q
. I IBS=3 S IBI="AUTHORIZED",IBY=$P(IBDS,U,10) Q
. I IBS=4 S IBI="PRINTED (First)",IBY=$P(IBDS,U,12) S:$P(IBDS,U,14)>IBY IBI="PRINTED (Last)",IBY=$P(IBDS,U,14) Q
. I IBS=5 S IBI="TRANSMITTED",IBY="" Q
. I IBS=7 S IBI="CANCELLED",IBY=$P(IBDS,U,17) Q
. I IBS=0 S IBI="CLOSED",IBY="" Q
S IBY=$$DATE(IBY),X=$$SETFLD^VALM1(IBY,X,"DATE")
S IBY="IB Status: "_IBI,X=$$SETFLD^VALM1(IBY,X,"TRTY")
;
S IBY=+IBDU1-$P(IBDU1,U,2),IBY=$J(IBY,11,2),X=$$SETFLD^VALM1(IBY,X,"TAMT")
S IBY=$P(IBAR,U,1),IBY=$J(IBY,11,2),X=$$SETFLD^VALM1(IBY,X,"CAMT")
D SET(X)
;
; AR profile of transactions
;
D TRN^RCJIBFN2(IBIFN)
I $D(^TMP("RCJIB",$J)) S IBI=0 F S IBI=$O(^TMP("RCJIB",$J,IBI)) Q:'IBI D
. S IBLN=^TMP("RCJIB",$J,IBI)
. S IBY=IBCNT+1,X=$$SETFLD^VALM1(IBY,X,"NUMBER")
. S IBY=$P(IBLN,U,1),X=$$SETFLD^VALM1(IBY,X,"TRNUM")
. S IBY=$$DATE(+$P(IBLN,U,2)),X=$$SETFLD^VALM1(IBY,X,"DATE")
. ; BEGIN IB*2*609 - Display Initials if this is a decrease adjustment
. I +$P(IBLN,U,3)'=35 S IBY=$P($$STNO^RCJIBFN2(+$P(IBLN,U,3)),U,1),X=$$SETFLD^VALM1(IBY,X,"TRTY")
. E D
. .N IBRCT0,IBUSR
. .S IBRCT0=$$N0^RCJIBFN1($P(IBLN,U))
. .S IBY=$P($$STNO^RCJIBFN2(+$P(IBLN,U,3)),U,1)
. .S IBUSR=$$GET1^DIQ(200,+$P(IBRCT0,U,3)_",",1)
. .S IBUSR=$S(IBUSR="POST":"Auto",1:IBUSR)
. .S IBY=IBY_" ("_IBUSR_")"
. .S X=$$SETFLD^VALM1(IBY,X,"TRTY")
. ; END IB*2*609
. S IBY=$J($P(IBLN,U,4),11,2),X=$$SETFLD^VALM1(IBY,X,"TAMT")
. S IBY=$J($P(IBLN,U,5),11,2),X=$$SETFLD^VALM1(IBY,X,"CAMT")
. D SET(X,+IBI)
;
D SET("") D SET("")
S X=" Total Collected: "_$J(+$P(IBAR,U,4),10,2) D SET(X)
I +$P(IBAR,U,5) S X=" Percent Collected: "_$J($P(IBAR,U,5),10,2)_"%" D SET(X)
;
; reason cancelled
I +$P(IBDS,U,18) K IBY D RCANC^IBJTU2(IBIFN,.IBY,47) I +IBY D
. S X=" Reason Cancelled by ("_$P(IBY,U,3)_"): ",X=X_$J(" ",(32-$L(X)))
. S IBI=0 F S IBI=$O(IBY(IBI)) Q:'IBI S X=X_IBY(IBI) D SET(X) S X=$J(" ",32)
;
K ^TMP("RCJIB",$J) I '$D(^TMP("IBJTTAX",$J)) K ^TMP("IBJTTA",$J,"IDX")
Q
;
DATE(X) ; date in external format
N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
Q Y
;
SET(X,TRNS) ; set up list manager screen array
S VALMCNT=VALMCNT+1 N CNT
S:+$G(TRNS) IBCNT=IBCNT+1 S CNT=$S(+IBCNT:IBCNT,1:1)
S ^TMP("IBJTTA",$J,VALMCNT,0)=X
S ^TMP("IBJTTA",$J,"IDX",VALMCNT,+CNT)=""
S:$G(TRNS) ^TMP("IBJTTAX",$J,CNT)=VALMCNT_U_IBIFN_U_$G(TRNS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTTA1 3045 printed Dec 13, 2024@02:24:08 Page 2
IBJTTA1 ;ALB/ARH - TPI AR ACCOUNT/CLAIM PROFILE BUILD ; 06-MAR-1995
+1 ;;2.0;INTEGRATED BILLING;**39,609**;21-MAR-94;Build 26
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
BLD ;
+1 NEW X,IBY,IBS,IBI,IBD0,IBDS,IBDU1,IBCNT,IBLN,IBAR
+2 SET IBD0=$GET(^DGCR(399,+IBIFN,0))
SET IBDS=$GET(^DGCR(399,+IBIFN,"S"))
SET IBDU1=$GET(^DGCR(399,+IBIFN,"U1"))
+3 SET IBAR=$$BILL^RCJIBFN2(IBIFN)
+4 ;
+5 SET VALMCNT=0
SET IBCNT=0
SET X=""
+6 ;
+7 ; original bill
+8 ;
+9 SET IBS=$PIECE(IBD0,U,13)
SET (IBI,IBY)=""
Begin DoDot:1
+10 IF IBS=1
SET IBI="ENTERED"
SET IBY=$PIECE(IBDS,U,1)
QUIT
+11 IF IBS=2
SET IBI="REVIEWED"
SET IBY=$PIECE(IBDS,U,4)
if $PIECE(IBDS,U,7)>IBY
SET IBI="REVIEWED (2nd)"
SET IBY=$PIECE(IBDS,U,7)
QUIT
+12 IF IBS=3
SET IBI="AUTHORIZED"
SET IBY=$PIECE(IBDS,U,10)
QUIT
+13 IF IBS=4
SET IBI="PRINTED (First)"
SET IBY=$PIECE(IBDS,U,12)
if $PIECE(IBDS,U,14)>IBY
SET IBI="PRINTED (Last)"
SET IBY=$PIECE(IBDS,U,14)
QUIT
+14 IF IBS=5
SET IBI="TRANSMITTED"
SET IBY=""
QUIT
+15 IF IBS=7
SET IBI="CANCELLED"
SET IBY=$PIECE(IBDS,U,17)
QUIT
+16 IF IBS=0
SET IBI="CLOSED"
SET IBY=""
QUIT
End DoDot:1
+17 SET IBY=$$DATE(IBY)
SET X=$$SETFLD^VALM1(IBY,X,"DATE")
+18 SET IBY="IB Status: "_IBI
SET X=$$SETFLD^VALM1(IBY,X,"TRTY")
+19 ;
+20 SET IBY=+IBDU1-$PIECE(IBDU1,U,2)
SET IBY=$JUSTIFY(IBY,11,2)
SET X=$$SETFLD^VALM1(IBY,X,"TAMT")
+21 SET IBY=$PIECE(IBAR,U,1)
SET IBY=$JUSTIFY(IBY,11,2)
SET X=$$SETFLD^VALM1(IBY,X,"CAMT")
+22 DO SET(X)
+23 ;
+24 ; AR profile of transactions
+25 ;
+26 DO TRN^RCJIBFN2(IBIFN)
+27 IF $DATA(^TMP("RCJIB",$JOB))
SET IBI=0
FOR
SET IBI=$ORDER(^TMP("RCJIB",$JOB,IBI))
if 'IBI
QUIT
Begin DoDot:1
+28 SET IBLN=^TMP("RCJIB",$JOB,IBI)
+29 SET IBY=IBCNT+1
SET X=$$SETFLD^VALM1(IBY,X,"NUMBER")
+30 SET IBY=$PIECE(IBLN,U,1)
SET X=$$SETFLD^VALM1(IBY,X,"TRNUM")
+31 SET IBY=$$DATE(+$PIECE(IBLN,U,2))
SET X=$$SETFLD^VALM1(IBY,X,"DATE")
+32 ; BEGIN IB*2*609 - Display Initials if this is a decrease adjustment
+33 IF +$PIECE(IBLN,U,3)'=35
SET IBY=$PIECE($$STNO^RCJIBFN2(+$PIECE(IBLN,U,3)),U,1)
SET X=$$SETFLD^VALM1(IBY,X,"TRTY")
+34 IF '$TEST
Begin DoDot:2
+35 NEW IBRCT0,IBUSR
+36 SET IBRCT0=$$N0^RCJIBFN1($PIECE(IBLN,U))
+37 SET IBY=$PIECE($$STNO^RCJIBFN2(+$PIECE(IBLN,U,3)),U,1)
+38 SET IBUSR=$$GET1^DIQ(200,+$PIECE(IBRCT0,U,3)_",",1)
+39 SET IBUSR=$SELECT(IBUSR="POST":"Auto",1:IBUSR)
+40 SET IBY=IBY_" ("_IBUSR_")"
+41 SET X=$$SETFLD^VALM1(IBY,X,"TRTY")
End DoDot:2
+42 ; END IB*2*609
+43 SET IBY=$JUSTIFY($PIECE(IBLN,U,4),11,2)
SET X=$$SETFLD^VALM1(IBY,X,"TAMT")
+44 SET IBY=$JUSTIFY($PIECE(IBLN,U,5),11,2)
SET X=$$SETFLD^VALM1(IBY,X,"CAMT")
+45 DO SET(X,+IBI)
End DoDot:1
+46 ;
+47 DO SET("")
DO SET("")
+48 SET X=" Total Collected: "_$JUSTIFY(+$PIECE(IBAR,U,4),10,2)
DO SET(X)
+49 IF +$PIECE(IBAR,U,5)
SET X=" Percent Collected: "_$JUSTIFY($PIECE(IBAR,U,5),10,2)_"%"
DO SET(X)
+50 ;
+51 ; reason cancelled
+52 IF +$PIECE(IBDS,U,18)
KILL IBY
DO RCANC^IBJTU2(IBIFN,.IBY,47)
IF +IBY
Begin DoDot:1
+53 SET X=" Reason Cancelled by ("_$PIECE(IBY,U,3)_"): "
SET X=X_$JUSTIFY(" ",(32-$LENGTH(X)))
+54 SET IBI=0
FOR
SET IBI=$ORDER(IBY(IBI))
if 'IBI
QUIT
SET X=X_IBY(IBI)
DO SET(X)
SET X=$JUSTIFY(" ",32)
End DoDot:1
+55 ;
+56 KILL ^TMP("RCJIB",$JOB)
IF '$DATA(^TMP("IBJTTAX",$JOB))
KILL ^TMP("IBJTTA",$JOB,"IDX")
+57 QUIT
+58 ;
DATE(X) ; date in external format
+1 NEW Y
SET Y=""
IF $GET(X)?7N.E
SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 QUIT Y
+3 ;
SET(X,TRNS) ; set up list manager screen array
+1 SET VALMCNT=VALMCNT+1
NEW CNT
+2 if +$GET(TRNS)
SET IBCNT=IBCNT+1
SET CNT=$SELECT(+IBCNT:IBCNT,1:1)
+3 SET ^TMP("IBJTTA",$JOB,VALMCNT,0)=X
+4 SET ^TMP("IBJTTA",$JOB,"IDX",VALMCNT,+CNT)=""
+5 if $GET(TRNS)
SET ^TMP("IBJTTAX",$JOB,CNT)=VALMCNT_U_IBIFN_U_$GET(TRNS)
+6 QUIT
