IBY348PO ;ALB/ESG - Post-Installation for IB patch 348 ;13-Sep-2006
;;2.0;INTEGRATED BILLING;**348**;21-MAR-94;Build 5
;
;
EN ;
N XPDIDTOT S XPDIDTOT=6
D SSN ; 1. remove force print SSN fields
D PARA ; 2. remove the default form type field
D DIC ; 3. update some file descriptions
D RIT ; 4. Recompile Input Templates
D TAB ; 5. reset the 1500 claim form address column
D LID ; 6. set default value for CMS-1500 PRINT LEGACY ID site parameter
EX ;
Q
;
SSN ; Remove 2 force print SSN fields from the insurance company file
NEW DIK,DA,IEN,DATA
D BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Removing force print SSN fields from file 36 ....")
;
; remove the fields from the data dictionary
S DIK="^DD(36,",DA=3.11,DA(1)=36 D ^DIK
S DIK="^DD(36,",DA=3.12,DA(1)=36 D ^DIK
;
; remove the data from the file
S IEN=0
F S IEN=$O(^DIC(36,IEN)) Q:'IEN D
. S DATA=$G(^DIC(36,IEN,3)) ; 3 node
. I $P(DATA,U,11)'="" S $P(^DIC(36,IEN,3),U,11)=""
. I $P(DATA,U,12)'="" S $P(^DIC(36,IEN,3),U,12)=""
. Q
;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(1)
Q
;
PARA ; remove the default form type field from the IB site parameter file.
; this field is obsolete because it was used to convert from the UB-82
; to the UB-92. It always had to be a UB form type and now there is
; only 1 UB form type.
NEW DIK,DA
D BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Removing default form type field from file 350.9 ....")
;
; remove the field from the data dictionary
S DIK="^DD(350.9,",DA=1.26,DA(1)=350.9 D ^DIK
;
; remove the data from the file
S $P(^IBE(350.9,1,1),U,26)=""
;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(2)
PARAX ;
Q
;
DIC ; update some file descriptions with CMS-1500
NEW HCFA,CMS,FILE,Z,TEXT,NEWTEXT
D BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Updating file descriptions for the CMS-1500 ....")
;
S HCFA="HCFA 1500",CMS="CMS-1500"
F FILE=353.1,353.2 S Z=0 F S Z=$O(^DIC(FILE,"%D",Z)) Q:'Z D
. S TEXT=$G(^DIC(FILE,"%D",Z,0)) Q:TEXT'[HCFA
. S NEWTEXT=$P(TEXT,HCFA,1)_CMS_$P(TEXT,HCFA,2)
. S ^DIC(FILE,"%D",Z,0)=NEWTEXT
. Q
;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(3)
DICX ;
Q
;
RIT ; Recompile input templates for billing screens
NEW X,Y,DMAX
D BMES^XPDUTL(" STEP 4 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Recompiling Input Templates for Billing Screens 3, 6 & 7....")
S X="IBXSC3",Y=$$FIND1^DIC(.402,,"X","IB SCREEN3","B"),DMAX=8000
I Y D EN^DIEZ
S X="IBXSC6",Y=$$FIND1^DIC(.402,,"X","IB SCREEN6","B"),DMAX=8000
I Y D EN^DIEZ
S X="IBXSC7",Y=$$FIND1^DIC(.402,,"X","IB SCREEN7","B"),DMAX=8000
I Y D EN^DIEZ
RITX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(4)
Q
;
TAB ; reset the CMS-1500 ADDRESS COLUMN field in the IB site parameter file.
; The new 1500 form has pre-printed information covering the first
; 26 columns over lines 1-6 where the payer name and address goes.
; If the column number in the parameter file is less than 28, change
; it to be 28.
D BMES^XPDUTL(" STEP 5 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Validating the CMS-1500 Address Column Value....")
;
N COL,DIE,DA,DR
S COL=$P($G(^IBE(350.9,1,1)),U,27)
I COL<28 S DIE=350.9,DA=1,DR="1.27///28" D ^DIE
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(5)
TABX ;
Q
LID ; set default value for CMS-1500 PRINT LEGACY ID site parameter
; This site parameter should default to "YES" (always print legacy id)
D BMES^XPDUTL(" STEP 6 of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Setting default value for CMS-1500 PRINT LEGACY ID site parameter....")
I $P($G(^IBE(350.9,1,1)),U,32)="" S DIE=350.9,DA=1,DR="1.32///YES" D ^DIE
LIDX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(6)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY348PO 3966 printed Sep 23, 2025@20:10:09 Page 2
IBY348PO ;ALB/ESG - Post-Installation for IB patch 348 ;13-Sep-2006
+1 ;;2.0;INTEGRATED BILLING;**348**;21-MAR-94;Build 5
+2 ;
+3 ;
EN ;
+1 NEW XPDIDTOT
SET XPDIDTOT=6
+2 ; 1. remove force print SSN fields
DO SSN
+3 ; 2. remove the default form type field
DO PARA
+4 ; 3. update some file descriptions
DO DIC
+5 ; 4. Recompile Input Templates
DO RIT
+6 ; 5. reset the 1500 claim form address column
DO TAB
+7 ; 6. set default value for CMS-1500 PRINT LEGACY ID site parameter
DO LID
EX ;
+1 QUIT
+2 ;
SSN ; Remove 2 force print SSN fields from the insurance company file
+1 NEW DIK,DA,IEN,DATA
+2 DO BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Removing force print SSN fields from file 36 ....")
+5 ;
+6 ; remove the fields from the data dictionary
+7 SET DIK="^DD(36,"
SET DA=3.11
SET DA(1)=36
DO ^DIK
+8 SET DIK="^DD(36,"
SET DA=3.12
SET DA(1)=36
DO ^DIK
+9 ;
+10 ; remove the data from the file
+11 SET IEN=0
+12 FOR
SET IEN=$ORDER(^DIC(36,IEN))
if 'IEN
QUIT
Begin DoDot:1
+13 ; 3 node
SET DATA=$GET(^DIC(36,IEN,3))
+14 IF $PIECE(DATA,U,11)'=""
SET $PIECE(^DIC(36,IEN,3),U,11)=""
+15 IF $PIECE(DATA,U,12)'=""
SET $PIECE(^DIC(36,IEN,3),U,12)=""
+16 QUIT
End DoDot:1
+17 ;
+18 DO MES^XPDUTL(" Done.")
+19 DO UPDATE^XPDID(1)
+20 QUIT
+21 ;
PARA ; remove the default form type field from the IB site parameter file.
+1 ; this field is obsolete because it was used to convert from the UB-82
+2 ; to the UB-92. It always had to be a UB form type and now there is
+3 ; only 1 UB form type.
+4 NEW DIK,DA
+5 DO BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
+6 DO MES^XPDUTL("-------------")
+7 DO MES^XPDUTL("Removing default form type field from file 350.9 ....")
+8 ;
+9 ; remove the field from the data dictionary
+10 SET DIK="^DD(350.9,"
SET DA=1.26
SET DA(1)=350.9
DO ^DIK
+11 ;
+12 ; remove the data from the file
+13 SET $PIECE(^IBE(350.9,1,1),U,26)=""
+14 ;
+15 DO MES^XPDUTL(" Done.")
+16 DO UPDATE^XPDID(2)
PARAX ;
+1 QUIT
+2 ;
DIC ; update some file descriptions with CMS-1500
+1 NEW HCFA,CMS,FILE,Z,TEXT,NEWTEXT
+2 DO BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Updating file descriptions for the CMS-1500 ....")
+5 ;
+6 SET HCFA="HCFA 1500"
SET CMS="CMS-1500"
+7 FOR FILE=353.1,353.2
SET Z=0
FOR
SET Z=$ORDER(^DIC(FILE,"%D",Z))
if 'Z
QUIT
Begin DoDot:1
+8 SET TEXT=$GET(^DIC(FILE,"%D",Z,0))
if TEXT'[HCFA
QUIT
+9 SET NEWTEXT=$PIECE(TEXT,HCFA,1)_CMS_$PIECE(TEXT,HCFA,2)
+10 SET ^DIC(FILE,"%D",Z,0)=NEWTEXT
+11 QUIT
End DoDot:1
+12 ;
+13 DO MES^XPDUTL(" Done.")
+14 DO UPDATE^XPDID(3)
DICX ;
+1 QUIT
+2 ;
RIT ; Recompile input templates for billing screens
+1 NEW X,Y,DMAX
+2 DO BMES^XPDUTL(" STEP 4 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Recompiling Input Templates for Billing Screens 3, 6 & 7....")
+5 SET X="IBXSC3"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN3","B")
SET DMAX=8000
+6 IF Y
DO EN^DIEZ
+7 SET X="IBXSC6"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN6","B")
SET DMAX=8000
+8 IF Y
DO EN^DIEZ
+9 SET X="IBXSC7"
SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN7","B")
SET DMAX=8000
+10 IF Y
DO EN^DIEZ
RITX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(4)
+3 QUIT
+4 ;
TAB ; reset the CMS-1500 ADDRESS COLUMN field in the IB site parameter file.
+1 ; The new 1500 form has pre-printed information covering the first
+2 ; 26 columns over lines 1-6 where the payer name and address goes.
+3 ; If the column number in the parameter file is less than 28, change
+4 ; it to be 28.
+5 DO BMES^XPDUTL(" STEP 5 of "_XPDIDTOT)
+6 DO MES^XPDUTL("-------------")
+7 DO MES^XPDUTL("Validating the CMS-1500 Address Column Value....")
+8 ;
+9 NEW COL,DIE,DA,DR
+10 SET COL=$PIECE($GET(^IBE(350.9,1,1)),U,27)
+11 IF COL<28
SET DIE=350.9
SET DA=1
SET DR="1.27///28"
DO ^DIE
+12 DO MES^XPDUTL(" Done.")
+13 DO UPDATE^XPDID(5)
TABX ;
+1 QUIT
LID ; set default value for CMS-1500 PRINT LEGACY ID site parameter
+1 ; This site parameter should default to "YES" (always print legacy id)
+2 DO BMES^XPDUTL(" STEP 6 of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Setting default value for CMS-1500 PRINT LEGACY ID site parameter....")
+5 IF $PIECE($GET(^IBE(350.9,1,1)),U,32)=""
SET DIE=350.9
SET DA=1
SET DR="1.32///YES"
DO ^DIE
LIDX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(6)
+3 QUIT
+4 ;
