| 1 | IBCEXTR1 ;ALB/JEH IB READY FOR EXTRACT STATUS SCREEN ;3/8/00 5:22am
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137**;21-MAR-1994
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | BLD ;Build list entry point
|
|---|
| 6 | K ^TMP("IBCERP6",$J),^TMP("IBCERP61",$J)
|
|---|
| 7 | N IBI,IBIFN,IBSTAT,IBREC,IBVSIT,IBCAT,IBILL,IBINS,IBPREC
|
|---|
| 8 | N IBEVDT,IBSTA,IBTYP,IBQUIT
|
|---|
| 9 | S (IBI,IBQUIT,IBIFN)=0 F S IBI=$O(^IBA(364,"ASTAT","X",IBI)) Q:'IBI S IBIFN=+$G(^IBA(364,IBI,0)) D
|
|---|
| 10 | .S IBSTAT=$$WNRBILL^IBEFUNC(IBIFN)
|
|---|
| 11 | .I 'IBSTAT,IBPARAM>0 Q
|
|---|
| 12 | .I IBSTAT Q
|
|---|
| 13 | .S IBREC=$G(^DGCR(399,+IBIFN,0))
|
|---|
| 14 | .S IBVSIT=$S($$INPAT^IBCEF(IBIFN,1)=1:"INP",1:"OPT")
|
|---|
| 15 | .S IBCAT=$S($$FT^IBCEF(IBIFN)=3:"INST",1:"PROF")
|
|---|
| 16 | .S IBILL=$$BN1^PRCAFN(IBIFN)
|
|---|
| 17 | .S IBINS=$P($G(^DIC(36,$$CURR^IBCEF2(IBIFN),0)),U)
|
|---|
| 18 | .S IBPREC=$P(^DPT($P(IBREC,U,2),0),U),IBSSN=$E($P(^DPT($P(IBREC,U,2),0),U,9),6,9)
|
|---|
| 19 | .S IBEVDT=$P($G(^DGCR(399,IBIFN,"U")),U) ;get statement date
|
|---|
| 20 | .S IBSTA=$$EXPAND^IBTRE(399,.13,$P(IBREC,U,13))
|
|---|
| 21 | .S IBTYP=$P(IBREC,U,24)_$P($G(^DGCR(399.1,$P(IBREC,U,25),0)),U,2)_$P(IBREC,U,26)
|
|---|
| 22 | .S ^TMP("IBCERP6",$J,IBSTAT,IBILL)=IBIFN_U_IBILL_U_IBVSIT_U_IBCAT_U_IBPREC_U_IBSSN_U_IBEVDT_U_IBTYP_U_IBINS_U_IBSTA
|
|---|
| 23 | ;
|
|---|
| 24 | SCRN ;--screen display
|
|---|
| 25 | S (IBCNT,VALMCNT)=0
|
|---|
| 26 | I '$D(^TMP("IBCERP6",$J)) D
|
|---|
| 27 | .S (VALMCNT,IBCNT)=2
|
|---|
| 28 | .S ^TMP("IBCERP61",$J,1,0)=" "
|
|---|
| 29 | .S ^TMP("IBCERP61",$J,2,0)="No records trapped in a Ready for Extract status found"
|
|---|
| 30 | S IBSTAT="" F S IBSTAT=$O(^TMP("IBCERP6",$J,IBSTAT)) Q:IBSTAT=""!(IBQUIT) D
|
|---|
| 31 | .S IBILL="" F S IBILL=$O(^TMP("IBCERP6",$J,IBSTAT,IBILL)) Q:IBILL=""!(IBQUIT) S IBREC=^(IBILL) D
|
|---|
| 32 | ..S IBCNT=IBCNT+1
|
|---|
| 33 | ..S IBIFN=+$P(IBREC,U)
|
|---|
| 34 | ..S X=$$SETFLD^VALM1(IBCNT,"","NUMBER")
|
|---|
| 35 | ..S X=$$SETFLD^VALM1($P(IBREC,U,2),X,"BILL")
|
|---|
| 36 | ..S X=$$SETFLD^VALM1($P(IBREC,U,3),X,"VISIT")
|
|---|
| 37 | ..S X=$$SETFLD^VALM1($P(IBREC,U,4),X,"CAT")
|
|---|
| 38 | ..S X=$$SETFLD^VALM1($E($P(IBREC,U,5),1,25),X,"NAME")
|
|---|
| 39 | ..S X=$$SETFLD^VALM1($P(IBREC,U,6),X,"SSN")
|
|---|
| 40 | ..S X=$$SETFLD^VALM1($$FDATE^VALM1($P(IBREC,U,7)),X,"STAMT")
|
|---|
| 41 | ..S X=$$SETFLD^VALM1($P(IBREC,U,8),X,"TYPE")
|
|---|
| 42 | ..S X=$$SETFLD^VALM1($E($P(IBREC,U,9),1,13),X,"INS")
|
|---|
| 43 | ..S X=$$SETFLD^VALM1($E($P(IBREC,U,10),1,7),X,"STAT")
|
|---|
| 44 | ..D SET(X,IBCNT,IBIFN)
|
|---|
| 45 | Q
|
|---|
| 46 | SET(X,CNT,IBIFN) ;list manager screen setup
|
|---|
| 47 | S VALMCNT=VALMCNT+1
|
|---|
| 48 | S ^TMP("IBCERP61",$J,VALMCNT,0)=X
|
|---|
| 49 | S ^TMP("IBCERP61",$J,"IDX",VALMCNT,CNT)=""
|
|---|
| 50 | S ^TMP("IBCERP61",$J,CNT)=VALMCNT_U_IBIFN_U_IBILL_U_IBSTAT
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
