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

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1IBCRLS ;ALB/ARH - RATES: DISPLAY SCHEDULES ; 16-MAY-1996
2 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBCR RATE SCHEDULE
6 D EN^VALM("IBCR RATE SCHEDULE")
7 Q
8 ;
9HDR ; -- header code
10 S VALMHDR(1)="Link types of payers and charges"
11 S VALMSG="~ charges not auto added to bills"
12 Q
13 ;
14INIT ; -- init variables and list array
15 K ^TMP("IBCRLS",$J),^TMP("IBCRLSX1",$J)
16 D BLD
17 Q
18 ;
19HELP ; -- help code
20 S X="?" D DISP^XQORM1 W !!
21 Q
22 ;
23EXIT ; -- exit code
24 K ^TMP("IBCRLS",$J),^TMP("IBCRLSX1",$J)
25 D CLEAR^VALM1,CLEAN^VALM10
26 Q
27 ;
28BLD ; build LM array for rate schedule display
29 N IBRT,IBBT,IBCNT,IBCNT1,IBRTBT,IBRSFN,IBCGS,IBLN,IBLN1,IBX,IBY,IBRS10,X S (VALMCNT,IBCNT)=0 K ^TMP($J,"IBCRRS")
30 ;
31 D SORTRS
32 ;
33 ; create LM display array
34 S IBRT="" F S IBRT=$O(^TMP($J,"IBCRRS",IBRT)) Q:IBRT="" D
35 . S IBBT="" F S IBBT=$O(^TMP($J,"IBCRRS",IBRT,IBBT)) Q:IBBT="" D
36 .. ;
37 .. S IBRTBT=$G(^TMP($J,"IBCRRS",IBRT,IBBT))
38 .. D SET("",IBRTBT) S IBY=" "_IBRT_": "_$$BTYPE(IBBT)
39 .. D SET(IBY) D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
40 .. ;
41 .. S IBRSFN=0 F S IBRSFN=$O(^TMP($J,"IBCRRS",IBRT,IBBT,IBRSFN)) Q:'IBRSFN D
42 ... S IBLN=$G(^IBE(363,IBRSFN,0)) Q:IBLN=""
43 ... S IBCNT=IBCNT+1,IBY=""
44 ... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"RSCHD")
45 ... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,4),2),IBY=$$SETFLD^VALM1(IBX,IBY,"BSVS")
46 ... S IBX=$$DATE(+$P(IBLN,U,5)),IBY=$$SETFLD^VALM1(IBX,IBY,"EFFDT")
47 ... S IBX=$$DATE(+$P(IBLN,U,6)),IBY=$$SETFLD^VALM1(IBX,IBY,"INADT")
48 ... ;
49 ... S IBRS10=$G(^IBE(363,IBRSFN,10)) I IBRS10'="" D
50 .... S IBY=$$SETFLD^VALM1(" Y",IBY,"ADJ") S X=100 X IBRS10
51 .... S IBX="(if base $=100, adjusted $="_$J(X,0,2)_") "_IBRS10,IBY=$$SETFLD^VALM1(IBX,IBY,"ADJMC")
52 ... ;
53 ... S IBCGS=0,IBCNT1=IBCNT F S IBCGS=$O(^IBE(363,IBRSFN,11,IBCGS)) Q:'IBCGS D
54 .... S IBLN1=$G(^IBE(363,IBRSFN,11,IBCGS,0)) Q:'IBLN1
55 .... S IBX=$P(IBLN1,U,2) I 'IBX S IBX="~",IBY=$$SETFLD^VALM1(IBX,IBY,"AA")
56 .... S IBX=$P($G(^IBE(363.1,+IBLN1,0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"CGSET")
57 .... D SET(IBY) S IBCNT1=0,IBY=""
58 ... I +IBCNT1 D SET(IBY)
59 ;
60 I VALMCNT=0 D SET(" "),SET("No Rate Schedules defined")
61 ;
62 K ^TMP($J,"IBCRRS")
63 Q
64 ;
65SET(X,RTBTLN) ; set up list manager screen array (if RTBTLN, the line is the first line of the rate tpe-bill type section)
66 S VALMCNT=VALMCNT+1
67 S ^TMP("IBCRLS",$J,VALMCNT,0)=X
68 I +$G(RTBTLN) S ^TMP("IBCRLSX1",$J,+RTBTLN,+$P(RTBTLN,U,2))=VALMCNT
69 Q
70 ;
71SORTRS ; sort rate schedules by rate type name, bill type
72 ; ^TMP($J,"IBCRRS", rate type, bill type)= rate type ifn ^ bill type
73 ; ^TMP($J,"IBCRRS", rate type, bill type, rate schedule IFN)=""
74 N IBRSFN,IBLN,IBRT,IBBT
75 S IBRSFN=0 F S IBRSFN=$O(^IBE(363,IBRSFN)) Q:'IBRSFN D
76 . S IBLN=$G(^IBE(363,IBRSFN,0)) Q:IBLN=""
77 . S IBRT=$P($G(^DGCR(399.3,+$P(IBLN,U,2),0)),U,1),IBBT=$P(IBLN,U,3)
78 . S ^TMP($J,"IBCRRS",IBRT,IBBT)=+$P(IBLN,U,2)_U_+$P(IBLN,U,3)
79 . S ^TMP($J,"IBCRRS",IBRT,IBBT,IBRSFN)=""
80 Q
81 ;
82DATE(X) ; date in external format
83 N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
84 Q Y
85 ;
86BTYPE(X) ; return abbreviated form of Bill Type
87 Q $S($G(X)>2:"Outpatient",$G(X)>0:"Inpatient",1:"")
Note: See TracBrowser for help on using the repository browser.