IBY280PR ;ALB/TMK - IB*2*280 PRE-INSTALL ;12-AUG-04
;;2.0;INTEGRATED BILLING;**280**;21-MAR-94
;
N INS,IBX,DIC,DIE,DIK,DA,DR,Y,X
D BMES^XPDUTL("Pre-Installation Updates")
;
D BMES^XPDUTL("Restore remote member in mail group MCR")
N IBMCR,IBMCH,DLAYGO,DIC,DIK,DA,DO,DD,Z,Z0 ; IA 4439
S IBMCR=+$O(^XMB(3.8,"B","MCR",0)),IBMCH=+$O(^XMB(3.8,"B","MCH",0)) S Z=0 F S Z=$O(^XMB(3.8,IBMCH,6,Z)) Q:'Z S Z0=$P($G(^XMB(3.8,IBMCH,6,Z,0)),U) I Z0'="" D
. I '$D(^XMB(3.8,IBMCR,6,"B",$E(Z0,1,30))) D
.. S DLAYGO=3.812,DIC(0)="L",X=Z0,DA(1)=IBMCR,DIC="^XMB(3.8,"_DA(1)_",6," D FILE^DICN K DO,DD,DA,DLAYGO,DIC
;
D BMES^XPDUTL("Updating/removing output formatter records")
;
; Make CI1-7 data element allow local override
S DA=1316,DIE="^IBA(364.6,",DR=".07////1" D ^DIE
;
; Delete entries 158/210 left over from changes to patch 232
F DA=158,210 S DIK="^IBA(364.7," D ^DIK
;
; Remove FL56 data from transmission file
F DA=906:1:910 D
. S DIE="^IBA(364.7,",DR=".03////5;1///K IBXDATA" D ^DIE
. S IBX(1)="Data is no longer transmitted."
. D WP^DIE(364.7,DA_",",3,"","IBX")
;
D ENDST
;
D BMES^XPDUTL("Update Provider ID types")
; Correct X12 codes for provider ID types
S IBX=0
F S IBX=$O(^IBE(355.97,IBX)) Q:+IBX=0 D
. Q:'$D(^IBE(355.97,IBX,0))
. S INS=$P(^IBE(355.97,IBX,0),"^",1)
. Q:INS=""
. I INS["CROSS" S $P(^IBE(355.97,IBX,0),"^",3)="1A"
. I INS["SHIELD" S $P(^IBE(355.97,IBX,0),"^",3)="1B"
. I INS["CHAMPUS"!(INS["TRICARE") S $P(^IBE(355.97,IBX,0),"^",3)="1H" I INS["CHAMPUS" S DA=IBX,DR=".01////TRICARE ID",DIE="^IBE(355.97," D ^DIE
. I INS["COMMER" S $P(^IBE(355.97,IBX,0),"^",3)="G2"
. I INS["CLIA" S $P(^IBE(355.97,IBX,0),"^",3)="X4"
. I INS["MEDICARE" S $P(^IBE(355.97,IBX,0),"^",3)="1C"
. I INS["TAX" S $P(^IBE(355.97,IBX,0),"^",3)="24"
. I INS["NETWORK" S $P(^IBE(355.97,IBX,0),"^",3)="N5"
. I INS["UPIN" S $P(^IBE(355.97,IBX,0),"^",3)="1G",$P(^(0),U,2)=0
. I INS["PPO" S $P(^IBE(355.97,IBX,0),"^",3)="B3"
. I INS["HMO" S $P(^IBE(355.97,IBX,0),"^",3)="BQ"
. I INS["SOCIAL" S $P(^IBE(355.97,IBX,0),"^",3)="SY"
. I INS["STATE" S $P(^IBE(355.97,IBX,0),"^",3)=$S(INS["LICENSE":"0B",1:"X5")
;
D ENDST
;
D BMES^XPDUTL("Remove xref on INSURANCE CO file, field 4.1 and delete bad values")
D DELIX^DDMOD(36,4.1,1,"","")
I $G(^IBA(364.7,1015,1))'["4010" S INS=0 F S INS=$O(^DIC(36,INS)) Q:'INS D
. S DR="4.01///@;4.02///@",DA=INS,DIE="^DIC(36," D ^DIE
;
D ENDST
;
D END
Q
;
ENDST ;
D BMES^XPDUTL("Step complete")
Q
;
END ;
D BMES^XPDUTL("Pre-install complete")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY280PR 2592 printed Oct 16, 2024@18:34:12 Page 2
IBY280PR ;ALB/TMK - IB*2*280 PRE-INSTALL ;12-AUG-04
+1 ;;2.0;INTEGRATED BILLING;**280**;21-MAR-94
+2 ;
+3 NEW INS,IBX,DIC,DIE,DIK,DA,DR,Y,X
+4 DO BMES^XPDUTL("Pre-Installation Updates")
+5 ;
+6 DO BMES^XPDUTL("Restore remote member in mail group MCR")
+7 ; IA 4439
NEW IBMCR,IBMCH,DLAYGO,DIC,DIK,DA,DO,DD,Z,Z0
+8 SET IBMCR=+$ORDER(^XMB(3.8,"B","MCR",0))
SET IBMCH=+$ORDER(^XMB(3.8,"B","MCH",0))
SET Z=0
FOR
SET Z=$ORDER(^XMB(3.8,IBMCH,6,Z))
if 'Z
QUIT
SET Z0=$PIECE($GET(^XMB(3.8,IBMCH,6,Z,0)),U)
IF Z0'=""
Begin DoDot:1
+9 IF '$DATA(^XMB(3.8,IBMCR,6,"B",$EXTRACT(Z0,1,30)))
Begin DoDot:2
+10 SET DLAYGO=3.812
SET DIC(0)="L"
SET X=Z0
SET DA(1)=IBMCR
SET DIC="^XMB(3.8,"_DA(1)_",6,"
DO FILE^DICN
KILL DO,DD,DA,DLAYGO,DIC
End DoDot:2
End DoDot:1
+11 ;
+12 DO BMES^XPDUTL("Updating/removing output formatter records")
+13 ;
+14 ; Make CI1-7 data element allow local override
+15 SET DA=1316
SET DIE="^IBA(364.6,"
SET DR=".07////1"
DO ^DIE
+16 ;
+17 ; Delete entries 158/210 left over from changes to patch 232
+18 FOR DA=158,210
SET DIK="^IBA(364.7,"
DO ^DIK
+19 ;
+20 ; Remove FL56 data from transmission file
+21 FOR DA=906:1:910
Begin DoDot:1
+22 SET DIE="^IBA(364.7,"
SET DR=".03////5;1///K IBXDATA"
DO ^DIE
+23 SET IBX(1)="Data is no longer transmitted."
+24 DO WP^DIE(364.7,DA_",",3,"","IBX")
End DoDot:1
+25 ;
+26 DO ENDST
+27 ;
+28 DO BMES^XPDUTL("Update Provider ID types")
+29 ; Correct X12 codes for provider ID types
+30 SET IBX=0
+31 FOR
SET IBX=$ORDER(^IBE(355.97,IBX))
if +IBX=0
QUIT
Begin DoDot:1
+32 if '$DATA(^IBE(355.97,IBX,0))
QUIT
+33 SET INS=$PIECE(^IBE(355.97,IBX,0),"^",1)
+34 if INS=""
QUIT
+35 IF INS["CROSS"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="1A"
+36 IF INS["SHIELD"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="1B"
+37 IF INS["CHAMPUS"!(INS["TRICARE")
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="1H"
IF INS["CHAMPUS"
SET DA=IBX
SET DR=".01////TRICARE ID"
SET DIE="^IBE(355.97,"
DO ^DIE
+38 IF INS["COMMER"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="G2"
+39 IF INS["CLIA"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="X4"
+40 IF INS["MEDICARE"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="1C"
+41 IF INS["TAX"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="24"
+42 IF INS["NETWORK"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="N5"
+43 IF INS["UPIN"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="1G"
SET $PIECE(^(0),U,2)=0
+44 IF INS["PPO"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="B3"
+45 IF INS["HMO"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="BQ"
+46 IF INS["SOCIAL"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)="SY"
+47 IF INS["STATE"
SET $PIECE(^IBE(355.97,IBX,0),"^",3)=$SELECT(INS["LICENSE":"0B",1:"X5")
End DoDot:1
+48 ;
+49 DO ENDST
+50 ;
+51 DO BMES^XPDUTL("Remove xref on INSURANCE CO file, field 4.1 and delete bad values")
+52 DO DELIX^DDMOD(36,4.1,1,"","")
+53 IF $GET(^IBA(364.7,1015,1))'["4010"
SET INS=0
FOR
SET INS=$ORDER(^DIC(36,INS))
if 'INS
QUIT
Begin DoDot:1
+54 SET DR="4.01///@;4.02///@"
SET DA=INS
SET DIE="^DIC(36,"
DO ^DIE
End DoDot:1
+55 ;
+56 DO ENDST
+57 ;
+58 DO END
+59 QUIT
+60 ;
ENDST ;
+1 DO BMES^XPDUTL("Step complete")
+2 QUIT
+3 ;
END ;
+1 DO BMES^XPDUTL("Pre-install complete")
+2 QUIT
+3 ;
