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

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1IBCEP1 ;ALB/TMP - EDI UTILITIES for provider ID ;13-DEC-99
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
3 ;
4CAREID(IBFUNC,IBSEQ,IBIFN) ; Help text for a claim to determine the
5 ; specific care unit needed for a given insurance co
6 ; IBFUNC = "PERF" if looking for performing provider
7 ; = "EMC" if looking for EMC provider #
8 ; IBSEQ = the number of the COB sequence for the insurance co
9 ; IBIFN = the ien of the bill in file 399
10 N Z,Z0,Z1,Z2
11 S Z0=$$INSSEQ(IBIFN,IBSEQ)
12 S Z1=$S(IBFUNC="PERF":"performing provider id",1:"EMC id")
13 S Z=$P($G(^DIC(36,+Z0,4)),U,$S(IBFUNC="PERF":9,1:8))
14 S Z2=$$PPTYP^IBCEP0(Z0)
15 I $O(^IBA(355.96,"AC",Z0,Z2,0)) D
16 . D EN^DDIOL("This insurance company needs a care unit "_$S(Z'="":"("_Z_") ",1:"")_"for their "_Z1)
17 E D
18 . D EN^DDIOL("This insurance company does not need a care unit for their "_Z1)
19 Q
20 ;
21INSSEQ(IBIFN,IBSEQ) ; Returns the ien of the insurance co for the COB
22 ; sequence IBSEQ on bill ien IBIFN
23 ; Returns 0 if no insurance co found
24 Q +$$FINDINS^IBCEF1(IBIFN,IBSEQ)
25 ;
26DUP(IBFLD,DA) ; Test if there is a duplicate record already on file (355.9)
27 ; Function returns 1 if dup found, 0 if no dup found
28 ; IBFLD = ien of the field being checked
29 ; DA = the ien of the record being checked
30 N DUP,Q,S1,S2,S3,S4,S5,S6,Z,Z0
31 S Q=$G(^IBA(355.9,+DA,0)),DUP=0
32 S S1=$S(IBFLD=.01:X,1:$P(Q,U))
33 S S2=$S(IBFLD=.02:X,1:$P(Q,U,15)),Z=$$EXPAND^IBTRE(355.9,.02,S2) S:Z="" Z="ALL INSURANCE CO" S:S2="" S2="*ALL*"
34 S S3=$S(IBFLD=.03:X,1:$P(Q,U,16)),Z0=$$EXPAND^IBTRE(355.9,.03,S3) S:Z0="" Z0="ALL CARE UNITS"
35 S S4=$S(IBFLD=.04:X,1:$P(Q,U,4))
36 S S5=$S(IBFLD=.05:X,1:$P(Q,U,5))
37 S S6=$S(IBFLD=.06:X,1:$P(Q,U,6))
38 I S1'="",S4'="",S5'="",S6'="",$O(^IBA(355.9,"AUNIQ",S1,S2,S3,S4,S5,S6,0)),$O(^(0))'=DA D
39 . N MSG
40 . S MSG(1)="Duplicate entry already on file:"
41 . S MSG(1,"F")="!!?3"
42 . S MSG(2)=$E($$EXPAND^IBTRE(355.9,.01,S1),1,25)_" "_$E(Z,1,29)_" "_$E(Z0,1,17)
43 . S MSG(2,"F")="!?5"
44 . S MSG(3)=$$EXPAND^IBTRE(355.9,.04,S4)_" "_$$EXPAND^IBTRE(355.9,.05,S5)_" "_$$EXPAND^IBTRE(355.9,.06,S6)
45 . S MSG(3,"F")="!?5"
46 . S MSG(4)=" ",MSG(4,"F")="!"
47 . D EN^DDIOL(.MSG)
48 . S DUP=1
49 Q DUP
50 ;
51DUP1(IBFLD,DA) ; Test if there is a duplicate record already on file (355.91)
52 ; Function returns 1 if dup found, 0 if no dup found
53 ; IBFLD = ien of the field being checked
54 ; DA = the ien of the record being checked
55 N DUP,Q,S1,S2,S3,S4,S5,Z0
56 S Q=$G(^IBA(355.91,+DA,0)),DUP=0
57 S S1=$S(IBFLD=.01:X,1:$P(Q,U))
58 S S2=$S(IBFLD=.03:X,1:$P(Q,U,10)),Z0=$$EXPAND^IBTRE(355.91,.03,S2) S:Z0="" Z0="ALL CARE UNITS"
59 S S3=$S(IBFLD=.04:X,1:$P(Q,U,4))
60 S S4=$S(IBFLD=.05:X,1:$P(Q,U,5))
61 S S5=$S(IBFLD=.06:X,1:$P(Q,U,6))
62 I S1'="",S3'="",S4'="",S5'="",$O(^IBA(355.91,"AUNIQ",S1,S2,S3,S4,S5,0)),$O(^(0))'=DA D
63 . N MSG
64 . S DUP=1
65 . S MSG(1)="Duplicate entry already on file:",MSG(1,"F")="!!?3"
66 . S MSG(2)=$E($$EXPAND^IBTRE(355.91,.01,S1),1,25)_" "_$E(Z0,1,30)
67 . S MSG(2,"F")="!?5"
68 . S MSG(3)=$$EXPAND^IBTRE(355.91,.04,S3)_" "_$$EXPAND^IBTRE(355.91,.05,S4)_" "_$$EXPAND^IBTRE(355.91,.06,S5)
69 . S MSG(3,"F")="!?5",MSG(4)=" ",MSG(4,"F")="!"
70 . D EN^DDIOL(.MSG)
71 Q DUP
72 ;
Note: See TracBrowser for help on using the repository browser.