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