Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY320PO

IBY320PO.m

Go to the documentation of this file. 
  1. IBY320PO ;ALB/ESG - Post Install for IB patch 320 ;28-JUL-2005
  1.  ;;2.0;INTEGRATED BILLING;**320**;21-MAR-94
  1.  ;
  1. EN ;
  1.  N XPDIDTOT S XPDIDTOT=9
  1.  D TWOQ         ; 1. get rid of 2Q status messages on CSA
  1.  D RCB          ; 2. change one EDI menu mnemonic
  1.  D ATD          ; 3. create regular style x-ref for file 361.4
  1.  D MCRWNR       ; 4. create 2 new entries in file 355.92 for Medicare
  1.  D TRIGGERS     ; 5. Trigger defaults in 36 and 355.93
  1.  D IBEFTFLG     ; 6. Set flag in 355.9 for what kind of ID it is
  1.  D AUNIQ        ; 7. create new style x-ref IBA(355.92,"AUNIQ")
  1.  D F35597       ; 8. Update file 355.97
  1.  D RIT          ; 9. Recompile input templates
  1.  ;
  1. EX ;
  1.  Q
  1.  ;
  1. TWOQ ; Remove 2Q rejection messages from the current CSA screen
  1.  NEW DATA,TXT,DO,DA,DIC,X,Y,IBRS,IEN
  1.  D BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Removing 2Q rejection messages from the CSA screen ....")
  1.  F IBRS=0,1 S IEN=0 F  S IEN=$O(^IBM(361,"ACSA","R",IBRS,IEN)) Q:'IEN  D
  1.  . I $G(^IBM(361,IEN,1,1,0))'["2Q  CLAIM REJECTED BY CLEARINGHOUSE" Q
  1.  . S DIE=361,DA=IEN
  1.  . ; Change the status message
  1.  . ; .03 - informational; .09 - review complete; .14 - auto filed
  1.  . ;  .1 - final review action (filed - no action)
  1.  . S DR=".03////I;.09////2;.14////1;.1////F"
  1.  . D ^DIE
  1.  . Q
  1.  ;
  1. TWOQX ;
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(1)
  1.  Q
  1.  ;
  1. RCB ; Change the menu mnemonic on the EDI menu for RCB
  1.  NEW MENUIEN,ITEMIEN,STOP,IBX,DIE,DA,DR
  1.  D BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Updating EDI menu mnemonics ....")
  1.  ;
  1.  S MENUIEN=$O(^DIC(19,"B","IBCE 837 EDI MENU",0)) I 'MENUIEN G RCBX
  1.  S ITEMIEN=0,STOP=0
  1.  F  S ITEMIEN=$O(^DIC(19,MENUIEN,10,ITEMIEN)) Q:'ITEMIEN  D  Q:STOP
  1.  . S IBX=$P($G(^DIC(19,MENUIEN,10,ITEMIEN,0)),U,1) Q:'IBX
  1.  . I $P($G(^DIC(19,IBX,0)),U,1)'="IBCE PREV TRANSMITTED CLAIMS" Q
  1.  . S DIE="^DIC(19,"_MENUIEN_",10,"
  1.  . S DA=ITEMIEN,DA(1)=MENUIEN
  1.  . S DR="2////RCB;3////40"
  1.  . D ^DIE
  1.  . S STOP=1
  1.  . Q
  1. RCBX ;
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(2)
  1.  Q
  1.  ;
  1. ATD ; create ATD x-ref on file 361.4
  1.  NEW IBIFN,DA,DIK
  1.  D BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Creating 'ATD' x-ref for File 361.4 ....")
  1.  KILL ^IBM(361.4,"ATD")
  1.  S IBIFN=0
  1.  F  S IBIFN=$O(^IBM(361.4,IBIFN)) Q:'IBIFN  D
  1.  . S DA(1)=IBIFN
  1.  . S DIK="^IBM(361.4,"_DA(1)_",1,"
  1.  . S DIK(1)=".01^ATD"
  1.  . D ENALL^DIK
  1.  . Q
  1. ATDX ;
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(3)
  1.  Q
  1.  ;
  1. MCRWNR ; Medicare (WNR) clean up file 355.92 entries and add 2 new entries
  1.  NEW DA,DIK,INSCO,MCRWNR,DO,DIC,X,Y,DFN,OK,IBIFN,BPID,DIE,DR
  1.  D BMES^XPDUTL(" STEP 4 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Updating Billing Provider IDs for MEDICARE (WNR) ....")
  1.  ;
  1.  ; First, find the MEDICARE (WNR) ins co ien
  1.  S INSCO=0
  1.  F  S INSCO=$O(^DIC(36,"B","MEDICARE (WNR)",INSCO)) Q:'INSCO  D
  1.  . I $$MCRWNR^IBEFUNC(INSCO) S MCRWNR(INSCO)="" Q
  1.  . D MES^XPDUTL("ERROR: Insurance company on file named 'MEDICARE (WNR)' incorrectly set-up.")
  1.  . Q
  1.  ;
  1.  I '$D(MCRWNR) D MES^XPDUTL("ERROR: Insurance company 'MEDICARE (WNR)' not found.") G MCRX
  1.  ;
  1.  I $O(MCRWNR(""))'=$O(MCRWNR(""),-1) D MES^XPDUTL("ERROR: Multiple insurance companies named 'MEDICARE (WNR)' found.")
  1.  ;
  1.  ; Next, get rid of any entries in this file for Medicare (clean-up)
  1.  S INSCO=0,DIK="^IBA(355.92,"
  1.  F  S INSCO=$O(MCRWNR(INSCO)) Q:'INSCO  D
  1.  . S DA=0
  1.  . F  S DA=$O(^IBA(355.92,"B",INSCO,DA)) Q:'DA  D ^DIK
  1.  . Q
  1.  ;
  1.  ; Next, add 2 entries for each Medicare (wnr) (should only be one)
  1.  S INSCO=0
  1.  F  S INSCO=$O(MCRWNR(INSCO)) Q:'INSCO  D
  1.  . K DO
  1.  . S DIC="^IBA(355.92,",DIC(0)="",X=INSCO
  1.  . S DIC("DR")=".04///1;.06///MEDICARE PART A;.07///670899;.08///E"
  1.  . D FILE^DICN
  1.  . K DO
  1.  . S DIC="^IBA(355.92,",DIC(0)="",X=INSCO
  1.  . S DIC("DR")=".04///2;.06///MEDICARE PART B;.07///VA0"_$P($$SITE^VASITE,U,3)_";.08///E"
  1.  . D FILE^DICN
  1.  . Q
  1.  ;
  1.  ; Correct billing provider secondary IDs for Medicare (current ins only)
  1.  S DFN=0
  1.  ; "AOP" x-ref lists bills by patient with claim status 1 or 2
  1.  F  S DFN=$O(^DGCR(399,"AOP",DFN)) Q:'DFN  D
  1.  . S INSCO=0,OK=0
  1.  . F  S INSCO=$O(MCRWNR(INSCO)) Q:'INSCO  I $D(^DGCR(399,"AE",DFN,INSCO)) S OK=1 Q
  1.  . ; OK=1: claims exist for this patient in which MCRWNR is curr ins
  1.  . I 'OK Q
  1.  . S IBIFN=0
  1.  . F  S IBIFN=$O(^DGCR(399,"AOP",DFN,IBIFN)) Q:'IBIFN  D
  1.  .. I $$COBN^IBCEF(IBIFN)'=1 Q      ; current payer seq must be primary
  1.  .. I '$$WNRBILL^IBEFUNC(IBIFN) Q   ; and payer must be Medicare
  1.  .. S BPID=670899
  1.  .. I $$FT^IBCEF(IBIFN)=2 S BPID="VA0"_$P($$SITE^VASITE,U,3)
  1.  .. ; BPID = what the billing provider ID should be
  1.  .. I $P($G(^DGCR(399,IBIFN,"M1")),U,2)=BPID Q    ; it is OK
  1.  .. S DIE=399,DA=IBIFN,DR="122///"_BPID D ^DIE    ; change it
  1.  .. Q
  1.  . Q
  1.  ;
  1. MCRX ;
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(4)
  1.  Q
  1.  ;
  1. TRIGGERS ;
  1.  D BMES^XPDUTL(" STEP 5 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Firing Triggers for default values file 36 and 355.93 and indexing new xrefs")
  1.  ;
  1.  S DIK="^DIC(36,"
  1.  S DIK(1)=".01^2^3^4^5^6"
  1.  D ENALL^DIK
  1.  ;
  1.  S DIK="^IBA(355.93,"
  1.  S DIK(1)=".09^1"
  1.  D ENALL^DIK
  1.  ;
  1.  S DIK="^IBA(355.93,"
  1.  S DIK(1)=".02^8"
  1.  D ENALL^DIK
  1.  ;
  1.  S DIK="^IBE(355.97,"
  1.  S DIK(1)=".03^1"
  1.  D ENALL^DIK
  1.  ;
  1.  ;
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(5)
  1.  Q
  1.  ;
  1. IBEFTFLG ;
  1.  ;
  1.  D BMES^XPDUTL(" STEP 6 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Setting ID Type flag for 355.92")
  1.  N DA,N0,Q,DIC,DR,DA
  1.  S DA=0 F  S DA=$O(^IBA(355.92,DA)) Q:'+DA  D
  1.  . S N0=$G(^IBA(355.92,DA,0))
  1.  . Q:N0=""
  1.  . Q:$P(N0,U,8)]""   ; already been done
  1.  . S Q=$P(N0,U,6)
  1.  . Q:Q=""    ; no qualifier
  1.  . S DR=".08////"_$S(Q=29:"E",1:"LF")
  1.  . S DIE="^IBA(355.92,"
  1.  . D ^DIE
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(6)
  1.  Q
  1.  ;
  1. AUNIQ ;xxxx/WCJ-CREATE NEW-STYLE XREF ;1:27 PM  30 Dec 2005
  1.  ;;1.0
  1.  ;
  1.  N ZZWJXR,ZZWJRES,ZZWJOUT
  1.  D BMES^XPDUTL(" STEP 7 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Create cross reference for file 355.92 ....")
  1.  S ZZWJXR("FILE")=355.92
  1.  S ZZWJXR("NAME")="AUNIQ"
  1.  S ZZWJXR("TYPE")="MU"
  1.  S ZZWJXR("USE")="S"
  1.  S ZZWJXR("EXECUTION")="R"
  1.  S ZZWJXR("ACTIVITY")="IR"
  1.  S ZZWJXR("SHORT DESCR")="Xref by ins co,care unit,form type,division,prov id type"
  1.  S ZZWJXR("DESCR",1)="This cross reference allows edits to the additonal provider id's to be "
  1.  S ZZWJXR("DESCR",2)="replicated to linked insurance companies."
  1.  S ZZWJXR("SET")="S ^IBA(355.92,""AUNIQ"",X(1),$E(X(2),1,30),X(3),X(4),X(5),DA)="""""
  1.  S ZZWJXR("KILL")="K ^IBA(355.92,""AUNIQ"",X(1),$E(X(2),1,30),X(3),X(4),X(5),DA)"
  1.  S ZZWJXR("WHOLE KILL")="K ^IBA(355.92,""AUNIQ"")"
  1.  S ZZWJXR("SET CONDITION")="S X=0 I X(1)]"""",X(2)]"""",X(3)]"""",X(4)]"""",X(5)]"""",$P($G(^IBA(355.92,DA,0)),U,8)=""A"" S X=1"
  1.  S ZZWJXR("KILL CONDITION")="S X=0 I X(1)]"""",X(2)]"""",X(3)]"""",X(4)]"""",X(5)]"""" S X=1"
  1.  S ZZWJXR("VAL",1)=.01
  1.  S ZZWJXR("VAL",1,"COLLATION")="F"
  1.  S ZZWJXR("VAL",2)=.1
  1.  S ZZWJXR("VAL",2,"LENGTH")=30
  1.  S ZZWJXR("VAL",2,"COLLATION")="F"
  1.  S ZZWJXR("VAL",3)=.04
  1.  S ZZWJXR("VAL",3,"COLLATION")="F"
  1.  S ZZWJXR("VAL",4)=.11
  1.  S ZZWJXR("VAL",4,"COLLATION")="F"
  1.  S ZZWJXR("VAL",5)=.06
  1.  S ZZWJXR("VAL",5,"COLLATION")="F"
  1.  D CREIXN^DDMOD(.ZZWJXR,"SW",.ZZWJRES,"ZZWJOUT")
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(7)
  1.  Q
  1.  ;
  1. F35597 ;
  1.  ;
  1.  D BMES^XPDUTL(" STEP 8 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Updating 355.97 ....")
  1.  ;
  1.  N IEN,CNV,NEW,OLD,DR,DIC,DIE,DA,X,DAT0,DAT1
  1.  ;
  1.  S CNV("BLUE CROSS ID")="BLUE CROSS^B"
  1.  S CNV("BLUE SHIELD ID")="BLUE SHIELD^B"
  1.  S CNV("TRICARE ID")="CHAMPUS^P"
  1.  S CNV("COMMERCIAL ID")="COMMERCIAL^B"
  1.  S CNV("CLIA #")="^P"
  1.  S CNV("MEDICARE PART A")="^B"
  1.  S CNV("MEDICARE PART B")="^B"
  1.  S CNV("FACILITY FED TAX ID #")="EMPLOYER'S IDENTIFICATION #"
  1.  S CNV("NETWORK ID")="PROVIDER PLAN NETWORK^B"
  1.  S CNV("PROVIDER FED TAX ID #")="FEDERAL TAXPAYER'S #^^TJ"
  1.  S CNV("UPIN")="^P"
  1.  S CNV("STATE LICENSE")="^B"
  1.  S CNV("HMO NUMBER")="HMO"
  1.  S CNV("STATE INDUSTRIAL ACCIDENT PRV")="ACCIDENT PROVIDER NUMBER^B"
  1.  S CNV("BILLING FACILITY PRIMARY ID")="ELECTRONIC PLAN TYPE^I"
  1.  S CNV("LOCATION NUMBER")="^B"
  1.  ;
  1.  S IEN=0 F  S IEN=$O(^IBE(355.97,IEN)) Q:'+IEN  D
  1.  . S OLD=$P($G(^IBE(355.97,IEN,0)),U)
  1.  . Q:OLD=""
  1.  . S DATA=$G(CNV(OLD))
  1.  . N FLAG
  1.  . S FLAG=$S(".1.2.3.6.8.11.12.16.18.20.21.22.23.24.25.26.27.28.29.30.31.32.33.34."[("."_IEN_"."):1,1:0)
  1.  . S DA=IEN
  1.  . S DIE=355.97
  1.  . S DR=""
  1.  . S:$P(DATA,U)]"" DR=DR_".01///"_$P(DATA,U)_";"
  1.  . S:$P(DATA,U,2)]"" DR=DR_".07///"_$P(DATA,U,2)_";"
  1.  . S:$P(DATA,U,3)]"" DR=DR_".03///"_$P(DATA,U,3)_";"
  1.  . S DR=DR_".04////@;.08////"_FLAG
  1.  . D ^DIE
  1.  . Q
  1.  ;
  1.  S NEW(30,0)="MEDICAID^0^1D^^^^B^1"
  1.  S NEW(30,1)="^^^^^^1"
  1.  S NEW(31,0)="USIN^0^U3^^^1^P^1"
  1.  S NEW(31,1)="^^^^^^0"
  1.  S NEW(32,0)="EIN^0^EI^^^1^B^1"
  1.  S NEW(33,0)="CLINIC NUMBER^0^FH^^^1^B^1"
  1.  S NEW(34,0)="PROVIDER SITE NUMBER^0^G5^^^1^B^1"
  1.  ;
  1.  S NEW="" F  S NEW=$O(NEW(NEW)) Q:NEW=""  D
  1.  . K DO
  1.  . S DAT0=$G(NEW(NEW,0))
  1.  . S DAT1=$G(NEW(NEW,1))
  1.  . S DIC="^IBE(355.97,"
  1.  . S DIC(0)=""
  1.  . S X=$P(DAT0,U)
  1.  . Q:X=""
  1.  . Q:$D(^IBE(355.97,"B",X))   ; already there (for running multiple times)
  1.  . S DIC("DR")=".02////0;.03////"_$P(DAT0,U,3)_$S($P(DAT0,U,6)]"":";.06////"_$P(DAT0,U,6),1:"")_";.07////"_$P(DAT0,U,7)_$S($P(DAT1,U,7)]"":";1.07////"_$P(DAT1,U,7),1:"")_";.08////"_$P(DAT0,U,8)
  1.  . D FILE^DICN
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(8)
  1.  Q
  1.  ;
  1. RIT ; Recompile input templates for billing screens
  1.  NEW X,Y,DMAX
  1.  D BMES^XPDUTL(" STEP 9 of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Recompiling Input Templates for Billing Screens 6 & 7....")
  1.  S X="IBXSC6",Y=$$FIND1^DIC(.402,,"X","IB SCREEN6","B"),DMAX=8000
  1.  I Y D EN^DIEZ
  1.  S X="IBXSC7",Y=$$FIND1^DIC(.402,,"X","IB SCREEN7","B"),DMAX=8000
  1.  I Y D EN^DIEZ
  1. RITX ;
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(9)
  1.  Q
  1.  ;