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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1IBCEP4 ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00
2 ;;2.0;INTEGRATED BILLING;**137,320,348,349,377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; -- main entry point
6 N IBINS,IBALL,IB95
7 D ENX
8 Q
9 ;
10EN1(IBINS) ; -- Entry point from provider number maintenence
11 N IBPRV,IBALL,IB95
12 S VALMBCK="R"
13 D ENX
14 Q
15 ;
16ENX ; Common call to list template for dual entry points
17 N IBSLEV,DIR,Y
18 K IBFASTXT
19 D FULL^VALM1
20 S DIR(0)="SA^1:Performing Provider Care Units;2:Billing Provider Care Units"
21 S DIR("A")="Enter Type of Care Unit: ",DIR("B")=$P($P(DIR(0),":",2),";",1)
22 W ! D ^DIR K DIR W !
23 I Y'>0 Q
24 S IBSLEV=+Y
25 I IBSLEV=2 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT") Q
26 D EN^VALM("IBCE PRVCARE UNIT MAINT")
27 Q
28 ;
29HDR ; -- header
30 K VALMHDR
31 S VALMHDR(1)=" "
32 S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL")
33 Q
34 ;
35INIT ; -- init variables, list array
36 N Z,IB,IBLCT,IBENT,IBNM,IB0,Z0,Z1,IBQ,DIR,Y,X
37 I $G(IBINS) S Y=IBINS ; For entrypoint from provider number maintenance
38 ;
39 I '$G(IBINS) D
40 . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units"
41 . D ^DIR K DIR
42 . I $D(DTOUT)!$D(DUOUT) S Y=-2 Q
43 . I Y>0 S IBINS=+Y Q
44 ;
45 I Y'=-2 D
46 . D BLD
47 E D
48 . S VALMQUIT=1
49 Q
50 ;
51BLD ; Bld display - IBINS must = ien of file 36
52 K ^TMP("IBPRV_CU",$J)
53 ;
54 I $G(IBSLEV)=2 Q
55 ;
56 S (IBENT,IBLCT)=0,IBNM=""
57 F S IBNM=$O(^IBA(355.95,"C",IBINS,IBNM)) Q:IBNM="" S Z=0 F S Z=$O(^IBA(355.95,"C",IBINS,IBNM,Z)) Q:'Z S IB=$G(^IBA(355.95,Z,0)) I IB'="",$P(IB,U,4)="" D
58 . S IBLCT=IBLCT+1,IBENT=IBENT+1
59 . I '$D(^IBA(355.96,"AUNIQ",IBINS,Z)) D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20)_" (NO COMBINATIONS FOUND)",IBENT) Q
60 . D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20),IBENT)
61 . S ^TMP("IBPRV_CU",$J,"ZIDX",IBENT)=Z
62 . S Z0=0 F S Z0=$O(^IBA(355.96,"AE",Z,Z0)) Q:'Z0 S Z1=0 F S Z1=$O(^IBA(355.96,"AE",Z,Z0,Z1)) Q:'Z1 S IB0=$G(^IBA(355.96,Z1,0)) I IB0'="" D
63 .. S IBLCT=IBLCT+1
64 .. S IBQ=$J("",28)_"o "_$E($$EXPAND^IBTRE(355.96,.06,+$P(IB0,U,6))_$J("",20),1,20)
65 .. S IBQ=IBQ_" "_$E($P("Both form types^UB-04 Only^CMS-1500 Only",U,$P(IB0,U,4)+1)_$J("",15),1,15)_" "_$E($P("Inpt/Outpt^Inpt Only^Outpt Only^RX Only",U,+$P(IB0,U,5)+1)_$J("",10),1,10)
66 .. D SET^VALM10(IBLCT,IBQ,IBENT)
67 ;
68 I 'IBLCT D SET^VALM10(1,"No CARE UNITs Found"_$S('$G(IBINS):"",1:" for Insurance Co")) S IBLCT=1
69 S VALMCNT=IBLCT,VALMBG=1
70 Q
71 ;
72HELP ; -- help
73 ;
74 I $G(IBSLEV)=2 Q
75 ;
76 S X="?" D DISP^XQORM1 W !!
77 Q
78 ;
79EXIT ; -- exit
80 D CLEAN^VALM10
81 K ^TMP("IBPRV_CU",$J),IBINS,IBALL
82 Q
83 ;
84EXPND ;
85 Q
86 ;
87SEL(IBDA,MANY) ; Select from care unit list
88 ; IBDA is passed by reference and IBDA(1) returned containing
89 ; ien's of the care unit selected (file 355.95).
90 ; If > 1 entry can be selected, MANY is set to 1
91 N Z
92 S IBDA=0
93 D EN^VALM2($G(XQORNOD(0)),$S($G(MANY):"",1:"S"))
94 S Z=0 F S Z=$O(VALMY(Z)) Q:'Z S IBDA=IBDA+1,IBDA(IBDA)=+$G(^TMP("IBPRV_CU",$J,"ZIDX",Z))
95 Q
96 ;
97DISP(IBVAR,IBINS,IBPTYP,IBFT,IBCT,START,END) ; Set up display array for
98 ; provider id
99 N Z
100 S START=$S($G(START):START,1:1)
101 S (Z,END)=$G(START)
102 S @IBVAR@(START)="INSURANCE: "_$S(IBINS:$P($G(^DIC(36,+IBINS,0)),U),1:"ALL INSURANCE")
103 S @IBVAR@(START+1)="PROV TYPE: "_$$EXPAND^IBTRE(355.96,.06,IBPTYP)
104 S @IBVAR@(START+2)="FORM TYPE: "_$$EXPAND^IBTRE(355.96,.04,IBFT)
105 S @IBVAR@(START+3)="CARE TYPE: "_$$EXPAND^IBTRE(355.96,.05,IBCT)
106 S END=$G(START)+3
107 Q
108 ;
109CAREUOK(IBIFN,IBCU,IBTYPE,IBSEQ) ; Returns 1 if care unit is appropriate
110 ; for bill based on provider type, care type, bill type and insurance co
111 ; IBIFN = ien of bill (file 399)
112 ; IBCU = the ien of the care unit (file 355.96)
113 ; IBTYPE = type of ID being checked (1=performing, 2=EMC)
114 ; IBSEQ = the COB seq being checked (1-3)
115 N Z,IBOK,IBINS,IBCT,IBFT,IBPTYP,IBRX
116 S IBOK=0
117 S IBINS=+$$FINDINS^IBCEF1(IBIFN,+IBSEQ),IBFT=$S($$FT^IBCEF(IBIFN)=2:2,1:1)
118 S IBPTYP=+$S(IBTYPE=1:$$PPTYP^IBCEP0(IBINS),1:$$EMCID^IBCEP())
119 S IBRX=$$ISRX^IBCEF1(IBIFN)
120 S IBCT=$S('IBRX:$S($$INPAT^IBCEF(IBIFN,1):1,1:2),1:3)
121 ;Check from most general to most specific
122 I $D(^IBA(355.96,"AD",IBINS,0,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
123 I 'IBRX,$D(^IBA(355.96,"AD",IBINS,IBFT,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
124 I $D(^IBA(355.96,"AD",IBINS,0,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
125 I $D(^IBA(355.96,"AD",IBINS,IBFT,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
126 ;
127CAREOKQ Q IBOK
128 ;
Note: See TracBrowser for help on using the repository browser.