source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM01.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1IBCEM01 ;ALB/TMP - BATCH BILLS LIST TEMPLATE ;11-SEP-96
2 ;;2.0;INTEGRATED BILLING;**137,296**;21-MAR-94
3 ;
4INIT ; -- set up inital variables
5 S VALMCNT=0,VALMBG=1
6 D BLD
7 Q
8 ;
9BLD ; -- build list of bills for batch entry # IBBDA
10 Q:'$G(IBBDA)
11 D REBLD
12 Q
13 ;
14REBLD ; Set up formatted global
15 ;
16 N IB,IBCNT,X,IB0,IB00,IBX,IBIFN,IBSTAT,IBSTAT1,IBZ
17 K ^TMP("IBCEM-BABI",$J),^TMP("IBCEM-BABIDX",$J)
18 S (VALMCNT,IBCNT)=0,IB=""
19 F S IB=$O(^IBA(364,"ABABI",IBBDA,IB)) Q:IB="" S IBZ=0 F S IBZ=$O(^IBA(364,"ABABI",IBBDA,IB,IBZ)) Q:'IBZ S IB0=$G(^IBA(364,IBZ,0)),IB00=$G(^DGCR(399,+IB0,0)) D
20 . S IBIFN=+$P(IB00,U,2),IBSTAT=$P(IB0,U,3),IBSTAT1=$P(IB00,U,13)
21 . S IB("S")=$G(^DGCR(399,+IB0,"U"))
22 . ; -- add to list
23 . S IBCNT=IBCNT+1,X="" W:'(IBCNT#25) "."
24 . S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
25 . S X=$$SETFLD^VALM1($S('$G(IBCEFUNC):"",1:$S($D(^TMP("IBNOT",$J,IBZ)):"*",$G(^TMP("IBEDI_TEST_BATCH",$J)):" ","RD"[IBSTAT!'IBSTAT1!(IBSTAT1=7):"#",1:" "))_$P(IB00,U),X,"BILLNO")
26 . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(399,.02,$P(IB00,U,2)),X,"PAT")
27 . S X=$$SETFLD^VALM1($P($G(^DPT(+$P(IB00,U,2),0)),U,9),X,"SSN")
28 . S X=$$SETFLD^VALM1($$FMTE^XLFDT($P(IB("S"),U),2)_"-"_$$FMTE^XLFDT($P(IB("S"),U,2),2),X,"DATES")
29 . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(399,.05,$P(IB00,U,5)),X,"TYPE")
30 . S X=$$SETFLD^VALM1($$EXPAND^IBTRE(364,.03,$P(IB0,U,3)),X,"TSTAT")
31 . D SET(X)
32 ;
33 I '$D(^TMP("IBCEM-BABI",$J)) S VALMCNT=2,IBCNT=2,^TMP("IBCEM-BABI",$J,1,0)=" ",^TMP("IBCEM-BABI",$J,2,0)=" No bills found for batch",^TMP("IBCEM-BABI",$J,"IDX",1,1)="",^TMP("IBCEM-BABI",$J,"IDX",2,2)=""
34 Q
35 ;
36EXIT ; -- Clean up list
37 K ^TMP("IBCEM-BABIDX",$J),^TMP("IBCEM-BABI",$J),IBCEFUNC
38 D CLEAR^VALM1,CLEAN^VALM10
39 Q
40 ;
41HDR ; -- Sets up header
42 N Z
43 S Z=$G(^IBA(364.1,IBBDA,0))
44 S VALMHDR(1)="BATCH #: "_$P(Z,U)_" "_$P(Z,U,8)
45 S VALMHDR(2)=$S(IBCEFUNC:" * = Bill excluded"_$S(IBCEFUNC=1:" # = Bill not in correct status for resubmit",1:""),1:" * = Bill not able to be edited")
46 S VALMSG=$G(IBCE("VALMSG"))
47 Q
48 ;
49SET(X) ; -- set arrays for 837 return messages
50 S VALMCNT=VALMCNT+1,^TMP("IBCEM-BABI",$J,VALMCNT,0)=X
51 S ^TMP("IBCEM-BABI",$J,"IDX",VALMCNT,IBCNT)=""
52 S ^TMP("IBCEM-BABIDX",$J,IBCNT)=VALMCNT_U_IB0
53 Q
54 ;
55SEL ; Select batch bill entry(ies) from list
56 N IBVAR,IBCT
57 K IBDAB
58 I $G(IBCEFUNC) D FULL^VALM1
59 D EN^VALM2($G(XQORNOD(0)))
60 S (IBCT,IBDAB)=0 F S IBDAB=$O(VALMY(IBDAB)) Q:'IBDAB S IBVAR=$G(^TMP("IBCEM-BABIDX",$J,IBDAB)),IBDAB(IBDAB)=$P(IBVAR,U,2) I $G(IBCEFUNC) D
61 . N Z,Z0,IBSTAT
62 . S IBSTAT=$P($G(^DGCR(399,+IBDAB(IBDAB),0)),U,13)
63 . S Z=+$O(^IBA(364,"ABABI",IBBDA,IBDAB(IBDAB),"")),Z0=$P($G(^DGCR(399,IBDAB(IBDAB),0)),U)
64 . I $G(IBCEFUNC)'=2,"RD"[$P(IBVAR,U,4)!'IBSTAT!(IBSTAT=7) K IBDAB(IBDAB) W !,"Bill #: ",Z0," already excluded (not in correct status for resubmit)" Q
65 . I $D(^TMP("IBNOT",$J,Z)) W !,"Bill #: ",Z0," has been included again" K ^TMP("IBNOT",$J,Z) S IBCT=IBCT-1 Q
66 . S ^TMP("IBNOT",$J,Z)=IBDAB(IBDAB),IBCT=IBCT+1 W !,"Bill #: ",Z0," will be excluded"
67 I $G(IBCEFUNC) D PAUSE^VALM1
68 S VALMBCK=$S('$G(IBCEFUNC):"Q",1:$S($O(VALMY("")):"R",1:"Q"))
69 S ^TMP("IBNOT",$J)=IBCT
70 I VALMBCK'="Q" D HDR,REBLD
71 I VALMBCK="Q" D EXIT
72 Q
73 ;
Note: See TracBrowser for help on using the repository browser.