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

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1IBJTLB1 ;ALB/ARH - TPI INACTIVE LIST BUILD ;2/14/95
2 ;;2.0;INTEGRATED BILLING;**39,80,61,137,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLDA ; build active list for third party joint inquiry active list, DFN must be defined
6 ; first search starts at dt and works backwards for 6 months of bills or IBMAXCNT bills, whichever is greater
7 ; all bills for a single day are included in the same search so even IBMAXCNT may be exceeded
8 ; if IBEND is defined on entry it is used as the end dt of the search, otherwise DT is used
9 ; IBBEG is left defined on exit, if it has a value then it is used by the Change Dates action to define the next
10 ; end date of the search, this results in each CD action default working backwards through the date range until
11 ; no bills are found and IBBEG is null then search restarts at DT, IBEND is defined so can tell if range changed
12 N IBIFN,IBCNT,IBBDT,IBEDT,IBFIRST,IBLAST,IBDT1,IBDT2,IBMAXCNT K IBHMSG
13 S IBEDT=$S(+$G(IBEND):IBEND,1:DT),IBBDT=$$FMADD^XLFDT(IBEDT,-180),IBMAXCNT=52
14 ;
15 S (VALMCNT,IBCNT)=0,IBDT1=$S(IBEDT'="":-(IBEDT+.01),1:""),IBDT2=-IBBDT
16 S IBFIRST=IBBDT,IBLAST=-$O(^DGCR(399,"APDS",DFN,""))
17 ;
18 F S IBDT1=$O(^DGCR(399,"APDS",DFN,IBDT1)) Q:'IBDT1!(IBDT1>IBDT2&(IBCNT'<IBMAXCNT)) S IBFIRST=-IBDT1 D
19 . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"APDS",DFN,IBDT1,IBIFN)) Q:'IBIFN I '$$ACTIVE^IBJTU4(IBIFN) D SCRN W "."
20 ;
21 S IBBEG=$S('IBDT1:"",IBBDT>IBFIRST:IBFIRST,1:IBBDT),IBBDT=$S(+IBBEG:$$DATE(IBBEG),1:"BEGIN")
22 S IBEND=$S(IBEDT=""!(IBLAST'>IBEDT):"",1:IBEDT),IBEDT=$S(+IBEND:$$DATE(IBEND),1:"END")
23 ;
24 I 'IBBEG,'IBEND S IBHMSG="** All Inactive Bills **"
25 I $G(IBHMSG)="" S IBHMSG=IBBDT_" - "_IBEDT
26 S IBHMSG=IBHMSG_" ("_VALMCNT_")"
27 ;
28 I VALMCNT=0 D SET(" ",0),SET("No Inactive Bills for this Patient",0)
29 ;
30 Q
31 ;
32SCRN ; add bill to screen list (IBIFN,DFN must be defined)
33 N X,IBY,IBD0,IBDU,IBDM S X=""
34 S IBCNT=IBCNT+1,IBD0=$G(^DGCR(399,+IBIFN,0)),IBDU=$G(^DGCR(399,+IBIFN,"U")),IBDM=$G(^DGCR(399,+IBIFN,"M"))
35 S IBY=IBCNT,X=$$SETFLD^VALM1(IBY,X,"NUMBER")
36 S IBY=$P(IBD0,U,1)_$$ECME^IBTRE(IBIFN),X=$$SETFLD^VALM1(IBY,X,"BILL")
37 S IBY=$S($$REF^IBJTU31(+IBIFN):"r",1:""),X=$$SETFLD^VALM1(IBY,X,"REFER")
38 S IBY=$S($$IB^IBRUTL(+IBIFN,0):"*",1:""),X=$$SETFLD^VALM1(IBY,X,"HD")
39 S IBY=$$DATE($P(IBDU,U,1)),X=$$SETFLD^VALM1(IBY,X,"STFROM")
40 S IBY=$$DATE($P(IBDU,U,2)),X=$$SETFLD^VALM1(IBY,X,"STTO")
41 ;
42 S IBY=$$TYPE($P(IBD0,U,5))_$$TF($P(IBD0,U,6)),X=$$SETFLD^VALM1(IBY,X,"TYPE")
43 S IBY=" "_$P($$ARSTATA^IBJTU4(IBIFN),U,2),X=$$SETFLD^VALM1(IBY,X,"ARST")
44 ;
45 S IBY=$P($G(^DGCR(399.3,+$P(IBD0,U,7),0)),U,4),X=$$SETFLD^VALM1(IBY,X,"RATE")
46 S IBY=$S($$MINS^IBJTU31(IBIFN):"+",1:""),X=$$SETFLD^VALM1(IBY,X,"CB")
47 S IBY=+$G(^DGCR(399,+IBIFN,"MP"))
48 I 'IBY,$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBY=+$$CURR^IBCEF2(IBIFN)
49 S IBY=$P($G(^DIC(36,+IBY,0)),U,1),X=$$SETFLD^VALM1(IBY,X,"INSUR")
50 S IBY=$$BILL^RCJIBFN2(IBIFN)
51 S X=$$SETFLD^VALM1($J(+$P(IBY,U,1),8,2),X,"OAMT")
52 S X=$$SETFLD^VALM1($J(+$P(IBY,U,3),8,2),X,"CAMT")
53 D SET(X,IBCNT)
54 Q
55 ;
56DATE(X) ; date in external format
57 Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
58 ;
59TYPE(X) ; return abbreviated form of Bill Classification (399,.05)
60 Q $S(X=1:"IP",X=2:"IH",X=3:"OP",X=4:"OH",1:"")
61 ;
62TF(X) ; return abbreviated form of Timeframe of Bill (399,.06)
63 Q $S(X=2:"-F",X=3:"-C",X=4:"-L",X'=1:"-O",1:"")
64 ;
65SET(X,CNT) ; set up list manager screen array
66 S VALMCNT=VALMCNT+1
67 S ^TMP("IBJTLB",$J,VALMCNT,0)=X Q:'CNT
68 S ^TMP("IBJTLB",$J,"IDX",VALMCNT,+CNT)=""
69 S ^TMP("IBJTLBX",$J,CNT)=VALMCNT_U_IBIFN
70 Q
Note: See TracBrowser for help on using the repository browser.