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

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

revised back to 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**;21-MAR-94;Build 46
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 D ENX
13 Q
14 ;
15ENX ; Common call to list template for dual entry points
16 N IBSLEV,DIR,Y
17 K IBFASTXT
18 D FULL^VALM1
19 S DIR(0)="SA^1:Care Units for Performing Provider IDs;2:Care Units for Billing Provider Secondary IDs"
20 S DIR("A")="Enter Type of Care Unit: ",DIR("B")=$P($P(DIR(0),":",2),";")
21 W ! D ^DIR K DIR W !
22 I Y'>0 Q
23 S IBSLEV=+Y
24 I IBSLEV=2 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT") Q
25 D EN^VALM("IBCE PRVCARE UNIT MAINT")
26 Q
27 ;
28HDR ; -- header
29 K VALMHDR
30 S VALMHDR(1)=" "
31 S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL")
32 Q
33 ;
34INIT ; -- init variables, list array
35 N Z,IB,IBLCT,IBENT,IBNM,IB0,Z0,Z1,IBQ,DIR,Y,X
36 I $G(IBINS) S Y=IBINS ; For entrypoint from provider number maintenance
37 ;
38 I '$G(IBINS) D
39 . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units"
40 . D ^DIR K DIR
41 . I $D(DTOUT)!$D(DUOUT) S Y=-2 Q
42 . I Y>0 S IBINS=+Y Q
43 ;
44 I Y'=-2 D
45 . D BLD
46 E D
47 . S VALMQUIT=1
48 Q
49 ;
50BLD ; Bld display - IBINS must = ien of file 36
51 K ^TMP("IBPRV_CU",$J)
52 ;
53 I $G(IBSLEV)=2 Q
54 ;
55 S (IBENT,IBLCT)=0,IBNM=""
56 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
57 . S IBLCT=IBLCT+1,IBENT=IBENT+1
58 . 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
59 . 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)
60 . S ^TMP("IBPRV_CU",$J,"ZIDX",IBENT)=Z
61 . 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
62 .. S IBLCT=IBLCT+1
63 .. S IBQ=$J("",28)_"o "_$E($$EXPAND^IBTRE(355.96,.06,+$P(IB0,U,6))_$J("",20),1,20)
64 .. 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)
65 .. D SET^VALM10(IBLCT,IBQ,IBENT)
66 ;
67 I 'IBLCT D SET^VALM10(1,"No CARE UNITs Found"_$S('$G(IBINS):"",1:" for Insurance Co"))
68 S VALMCNT=IBLCT,VALMBG=1
69 Q
70 ;
71HELP ; -- help
72 ;
73 I $G(IBSLEV)=2 Q
74 ;
75 S X="?" D DISP^XQORM1 W !!
76 Q
77 ;
78EXIT ; -- exit
79 K IBFASTXT
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.