source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEXTR1.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1IBCEXTR1 ;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 ;
5BLD ;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 ;
24SCRN ;--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
46SET(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 ;
Note: See TracBrowser for help on using the repository browser.