1 | IBY288PO ;ALB/ESG - IB*2*288 POST-INSTALL ROUTINE ;21-OCT-2004
|
---|
2 | ;;2.0;INTEGRATED BILLING;**288**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | EN ; Entry Point
|
---|
6 | ;
|
---|
7 | D AEXREF
|
---|
8 | D FACBILID
|
---|
9 | D TESTQ
|
---|
10 | ;
|
---|
11 | Q
|
---|
12 | ;
|
---|
13 | AEXREF ; Build the new and improved "AE" x-ref in file 399
|
---|
14 | D BMES^XPDUTL("Removing the old ""AE"" index file data and definition")
|
---|
15 | D DELIX^DDMOD(399,135,1)
|
---|
16 | KILL ^DGCR(399,"AE")
|
---|
17 | D MES^XPDUTL("Done")
|
---|
18 | ;
|
---|
19 | D BMES^XPDUTL("Creating the new ""AE"" index file data and definition")
|
---|
20 | N IBXR,IBRES,IBOUT
|
---|
21 | S IBXR("FILE")=399
|
---|
22 | S IBXR("NAME")="AE"
|
---|
23 | S IBXR("TYPE")="MU"
|
---|
24 | S IBXR("USE")="S"
|
---|
25 | S IBXR("EXECUTION")="R"
|
---|
26 | S IBXR("ACTIVITY")="IR"
|
---|
27 | S IBXR("SHORT DESCR")="Index by patient and insurance company"
|
---|
28 | S IBXR("DESCR",1)="Cross reference of patients and bills to payer responsible for the bill."
|
---|
29 | S IBXR("DESCR",2)="This will be used to prevent deletion of insurance policy entries from the"
|
---|
30 | S IBXR("DESCR",3)="patient file if a bill has been created for this insurance company."
|
---|
31 | S IBXR("DESCR",4)=" "
|
---|
32 | S IBXR("DESCR",5)="Created with patch IB*2.0*288 replacing traditional cross-reference #1 in "
|
---|
33 | S IBXR("DESCR",6)="field 135 of file 399. Medicare is now a valid insurance company for "
|
---|
34 | S IBXR("DESCR",7)="this index file."
|
---|
35 | S IBXR("SET")="N CURR S CURR=+$$COBN^IBCEF(DA) I $G(X(4)),$G(X(CURR)) S ^DGCR(399,""AE"",X(4),X(CURR),DA)="""""
|
---|
36 | S IBXR("KILL")="N G I $G(X(4)) F G=1,2,3 I $G(X(G)) K ^DGCR(399,""AE"",X(4),X(G),DA)"
|
---|
37 | S IBXR("WHOLE KILL")="K ^DGCR(399,""AE"")"
|
---|
38 | S IBXR("VAL",1)=101
|
---|
39 | S IBXR("VAL",1,"COLLATION")="F"
|
---|
40 | S IBXR("VAL",2)=102
|
---|
41 | S IBXR("VAL",2,"COLLATION")="F"
|
---|
42 | S IBXR("VAL",3)=103
|
---|
43 | S IBXR("VAL",3,"COLLATION")="F"
|
---|
44 | S IBXR("VAL",4)=.02
|
---|
45 | S IBXR("VAL",4,"COLLATION")="F"
|
---|
46 | D CREIXN^DDMOD(.IBXR,"SW",.IBRES,"IBOUT")
|
---|
47 | I +$G(IBRES) D MES^XPDUTL("Index successfully created!") G AEXXX
|
---|
48 | ;
|
---|
49 | ; Index file failure. Not created for some reason
|
---|
50 | ;
|
---|
51 | D MES^XPDUTL("A PROBLEM WAS ENCOUNTERED. INDEX FILE NOT CREATED!!!")
|
---|
52 | D MES^XPDUTL("SENDING MAILMAN MESSAGE...")
|
---|
53 | D MES^XPDUTL("PLACING THE 'PATIENT INSURANCE INFO VIEW/EDIT' OPTION OUT-OF-ORDER.")
|
---|
54 | NEW XMDUZ,XMSUBJ,XMBODY,MSG,XMTO,DA,DIE,DR,IBX
|
---|
55 | S XMDUZ=DUZ,XMSUBJ="IB*2*288 Error: AE index not built",XMBODY="MSG"
|
---|
56 | S MSG(1)="The updated ""AE"" index for file 399 was not created at"
|
---|
57 | S MSG(2)=" "
|
---|
58 | S MSG(3)=" "_$$SITE^VASITE
|
---|
59 | S MSG(4)=" "
|
---|
60 | S MSG(5)="The Patient Insurance Info View/Edit option has been placed out of order."
|
---|
61 | ;
|
---|
62 | ; recipients of message
|
---|
63 | S XMTO(DUZ)=""
|
---|
64 | S XMTO("eric.gustafson@daou.com")=""
|
---|
65 | S XMTO("michael.f.pida@us.pwc.com")=""
|
---|
66 | S XMTO("Janet.Harris2@med.va.gov")=""
|
---|
67 | S XMTO("Cari.Hutchison@med.va.gov")=""
|
---|
68 | S XMTO("G.PATCHES")=""
|
---|
69 | S IBX=0 F S IBX=$O(^XUSEC("IB INSURANCE SUPERVISOR",IBX)) Q:'IBX S XMTO(IBX)=""
|
---|
70 | ;
|
---|
71 | D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
|
---|
72 | ;
|
---|
73 | ; place the option out of order
|
---|
74 | S DA=$O(^DIC(19,"B","IBCN PATIENT INSURANCE",""))
|
---|
75 | I DA S DIE=19,DR="2////IB Patch 288 Installation Failure" D ^DIE
|
---|
76 | AEXXX ;
|
---|
77 | Q
|
---|
78 | ;
|
---|
79 | FACBILID ; move the hosp and prof provider ID#'s in file 36 for the
|
---|
80 | ; Medicare (WNR) entry into file 355.92.
|
---|
81 | ;
|
---|
82 | D BMES^XPDUTL("Updating facility provider ids for MEDICARE (WNR)")
|
---|
83 | N DO,DD,DLAYGO,DIC,X,Y,Z,Z0,Z00,Z11,Z17,IBINS,IBID,IBHCFA,IBUB
|
---|
84 | S IBID=$$BF^IBCU()
|
---|
85 | I IBID S IBINS=0 F S IBINS=$O(^DIC(36,"B","MEDICARE (WNR)",IBINS)) Q:'IBINS S Z11=$P($G(^DIC(36,IBINS,0)),U,11),Z17=$P($G(^DIC(36,IBINS,0)),U,17) D
|
---|
86 | . S (IBHCFA,IBUB)=0
|
---|
87 | . S Z0=0 F S Z0=$O(^IBA(355.92,"B",IBINS,Z0)) Q:'Z0 S Z00=$G(^IBA(355.92,Z0,0)) D Q:IBHCFA&IBUB
|
---|
88 | .. I $P(Z00,U,6)=IBID S:$P(Z00,U,4)=2 IBHCFA=1 S:$P(Z00,U,4)=1 IBUB=1 Q
|
---|
89 | . I Z11'="",'IBUB S X=IBINS,DIC("DR")=".04////1;.06////"_IBID_";.07////"_Z11,DIC="^IBA(355.92,",DLAYGO=355.92,DIC(0)="L" D FILE^DICN K DO,DD,DLAYGO,DIC
|
---|
90 | . I Z17'="",'IBHCFA S X=IBINS,DIC("DR")=".04////2;.06////"_IBID_";.07////"_Z17,DIC="^IBA(355.92,",DLAYGO=355.92,DIC(0)="L" D FILE^DICN K DO,DD,DLAYGO,DIC
|
---|
91 | ;
|
---|
92 | FACBILX ;
|
---|
93 | Q
|
---|
94 | ;
|
---|
95 | TESTQ ; Change the 837 test transmission queue to be "MCT"
|
---|
96 | D BMES^XPDUTL("Setting the EDI 837 Test Transmit Queue to ""MCT""")
|
---|
97 | S $P(^IBE(350.9,1,8),U,9)="MCT"
|
---|
98 | TESTQX ;
|
---|
99 | Q
|
---|
100 | ;
|
---|