| 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 | ; | 
|---|