- 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 Feb 19, 2025@00:00:06 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 ;