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

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1IBCEP5A ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00
2 ;;2.0;INTEGRATED BILLING;**137,232,320,348**;21-MAR-94;Build 5
3 ;
4NEW(IBPRV,IBINS) ; Add new prov id
5 D FULL^VALM1
6 N DIC,DIR,X,Y,DA,DO,DD,DLAYGO,IBQ,IBIEN,IBPRV0,DTOUT,DUOUT,IBIF,IBSIC
7 S IBQ=0,IBPRV0=$S(IBPRV'["355.93":"",1:$G(^IBA(355.93,+IBPRV,0)))
8 ;
9 ; Only 5 secondary providers allowed for lab/facilities
10 S IBIF=$P(IBPRV0,U,2)
11 S IBSIC=$O(^TMP("IBPRV_",$J,"ZIDX",""),-1)
12 I IBIF=1,IBSIC>4 D G NEWQ
13 . S DIR(0)="EA",DIR("A",1)="A maximum of 5 secondary IDs are allowed for a lab/facility.",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR W !
14 ;
15 S DIR(0)="PAr^355.97:AEMQ"
16 S DIR("A")="Enter Provider ID Qualifier: "
17 S DIR("?")="Enter a Qualifier to indentify the type of ID number you are entering."
18 ;
19 ;S DIR("S")=$S($G(IBINS):"I ""04""[+$P($G(^(0)),U,2)",1:"I +$P($G(^(1)),U,7)&'$G(^(1))&$S($P(IBPRV0,U,2)'=1:1,1:$P(^(0),U,3)'=""SY"")")
20 I $G(IBINS) D
21 . I $P(IBPRV0,U,2)=1 S DIR("S")="I $$LFINS^IBCEPU(Y)" Q ; Lab or Facility ID provided by ins
22 . S DIR("S")="I $$RAINS^IBCEPU(Y)" Q ; Non VA Ind provided by ins
23 I '$G(IBINS) D
24 . I $P(IBPRV0,U,2)=1 D Q
25 .. I IBPRV["VA(200," S DIR("S")="I $$LFINS^IBCEPU(Y)" Q ; VA facility own IDS
26 .. S DIR("S")="I $$NVALFOWN^IBCEPU(Y)" Q ; Non -VA facility own
27 . S DIR("S")="I $$RAOWN^IBCEPU(Y)" ; FACILITY/GROUP;PROVIDER'S OWN PERSONAL NUMBER
28 ;
29 D ^DIR K DIR
30 I $D(DTOUT)!$D(DUOUT) S IBQ=1 G NEWQ
31 I $P($G(^IBE(355.97,+Y,1)),U,3),IBPRV["355.93" D G NEWQ
32 . K DIE,DR
33 . S DIE="^IBA(355.93,",DA=+IBPRV
34 . S DR="S Y=""@5"";@1;.07;@5;I $P($G(^IBA(355.93,DA,0)),U,7)'="""" S Y=""@2"";W !!,""YOU MUST HAVE A STATE TO USE LICENSE # AS AN ID!!"",! S Y=""@1"";@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,7),0)),U,2);.12"
35 . D ^DIE
36 . I '$D(Y) D BLD^IBCEP5
37 K IB3559(.06)
38 S IB3559(.06)=+Y
39 ;
40 I $G(IBINS)'="NO",'$G(IBINS),'$P($G(^IBE(355.97,IB3559(.06),1)),U,8) D G:IBQ NEWQ
41 . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select the INSURANCE CO that is furnishing you with the provider ID"
42 . D ^DIR K DIR
43 . I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
44 . S IBINS=$S(Y>0:+Y,1:"")
45 S IB3559(.02)=$S($G(IBINS):IBINS,1:"*ALL*")
46 ;
47 I '$P($G(^IBE(355.97,IB3559(.06),1)),U,8) D G:'IBIEN NEWQ
48 . S DIC(0)="L",DLAYGO=355.9,DIC="^IBA(355.9,",X=IBPRV
49 . S:$G(IBINS) DIC("DR")=".02////"_IBINS
50 . D FILE^DICN K DIC,DLAYGO,DD,DO
51 . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0 Q
52 . S IBIEN=+Y
53 . D NEWID^IBCEP5B(355.9,IB3559(.02),IBPRV,IB3559(.06),IBIEN,1)
54 ;
55 E D ; Provider-specific id stored outside of billing
56 . N DIR,X,Y,Z
57 . ; State License # is stored in file 200
58 . ; DEA# may not be edited in IB
59 . S Z=$G(^IBE(355.97,IB3559(.06),1))
60 . I +Z D Q
61 .. W ! S DIR(0)="EA",DIR("A",1)="DEA # CANNOT BE EDITED WITHIN THE BILLING SOFTWARE",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR W !
62 . I $P(Z,U,3) D
63 .. D PRVED(+IBPRV)
64 D BLD^IBCEP5
65NEWQ K VALMBCK
66 S VALMBCK="R"
67 Q
68 ;
69DEL1 ; Delete Provider specific ID's
70 N IBDA,DA,DIE,DR
71 D FULL^VALM1
72 D SEL^IBCEP5(.IBDA)
73 G:'$O(IBDA(0)) DEL1Q
74 S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
75 G:'IBDA&($E($P(IBDA,U),1,3)'="LIC") DEL1Q
76 I IBDA>0 D DEL^IBCEP5B(355.9,IBDA,""),BLD^IBCEP5
77 E D ; check for state license
78 . Q:$E($P(IBDA,U),1,3)'="LIC"
79 . I $P(IBDA,U,2)["IBA(355.93" D
80 .. S DA=+$P(IBDA,U,2),DR=".12///@",DIE="^IBA(355.93," D ^DIE
81 . E D
82 .. D PRVED(+$P(IBDA,U,2))
83 . D BLD^IBCEP5
84DEL1Q S VALMBCK="R"
85 Q
86 ;
87CHG1 ; Edit Provider ID's
88 N IBDA,DIR,DA,DIE,DR,Z
89 D FULL^VALM1
90 D SEL^IBCEP5(.IBDA)
91 G:'$O(IBDA(0)) CHG1Q
92 S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
93 I IBDA>0 D
94 . D CHG^IBCEP5B(355.9,IBDA),BLD^IBCEP5
95 ; check for state license
96 E D
97 . Q:$E($P(IBDA,U),1,3)'="LIC"
98 . I $P(IBDA,U,2)["IBA(355.93" D
99 .. S DA=+$P(IBDA,U,2),DIE="^IBA(355.93,"
100 .. S DR="S Y=""@5"";@1;.07;@5;I $P($G(^IBA(355.93,DA,0)),U,7)'="""" S Y=""@2"";W !,""YOU MUST HAVE A STATE TO USE LICENSE # AS AN ID!!"" S Y=""@1"";@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,7),0)),U,2);.12"
101 .. D ^DIE
102 . E D
103 .. D PRVED(+$P(IBDA,U,2))
104 . D BLD^IBCEP5
105CHG1Q S VALMBCK="R"
106 Q
107 ;
108PRVED(IBPRV) ; Maintain license #'s for VA provider ien IBPRV
109 S IBPRV=IBPRV_";VA(200,"
110 D EN^IBCEP5D
111 Q
112 ;
113COPYPROV(IBINS) ; Check if any ID's were edited and this is a parent insurance company
114 ; IBINS = IEN into Insurance co file
115 ;
116 Q:'$D(^TMP("IB_EDITED_IDS",$J))
117 K ^TMP("IB_EDITED_IDS",$J)
118 D COPY^IBCEPCID(IBINS)
119 Q
120 ;
121 ; Get the next number so that the edits can be replicated in order for other providers/insurance companies
122NEXTONE() ;
123 Q $O(^TMP("IB_EDITED_IDS",$J,""),-1)+1
Note: See TracBrowser for help on using the repository browser.