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

IBY349PO.m

Go to the documentation of this file.
  1. IBY349PO ;ALB/ESG - Post-Installation for IB patch 349 ;27-Nov-2006
  1. ;;2.0;INTEGRATED BILLING;**349**;21-MAR-94;Build 46
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. EN ;
  1. N XPDIDTOT S XPDIDTOT=4
  1. D LID ; 1. set default value for UB PRINT LEGACY ID parameter
  1. D PARA ; 2. remove the PRINT '001' FOR TOTAL CHARGES? field
  1. D RIT ; 3. recompile some billing screen input templates
  1. D DIC ; 4. update some file descriptions
  1. EX ;
  1. Q
  1. ;
  1. LID ; set default value for UB PRINT LEGACY ID site parameter
  1. ; This site parameter should default to "YES" (always print legacy id)
  1. NEW DIE,DA,DR
  1. D BMES^XPDUTL(" STEP 1 of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Setting default value for UB PRINT LEGACY ID site parameter...")
  1. I $P($G(^IBE(350.9,1,1)),U,33)="" S DIE=350.9,DA=1,DR="1.33///YES" D ^DIE
  1. LIDX ;
  1. D MES^XPDUTL(" Done.")
  1. D UPDATE^XPDID(1)
  1. Q
  1. ;
  1. PARA ; remove the PRINT '001' FOR TOTAL CHARGES? field from the IB site
  1. ; parameters file. This field is obsolete.
  1. NEW DIK,DA
  1. D BMES^XPDUTL(" STEP 2 of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Removing '001' for Total field from file 350.9 ....")
  1. ;
  1. ; remove the field from the data dictionary
  1. S DIK="^DD(350.9,",DA=1.1,DA(1)=350.9 D ^DIK
  1. ;
  1. ; remove the data from the file
  1. S $P(^IBE(350.9,1,1),U,10)=""
  1. ;
  1. D MES^XPDUTL(" Done.")
  1. D UPDATE^XPDID(2)
  1. PARAX ;
  1. Q
  1. ;
  1. RIT ; Recompile input templates for billing screens
  1. NEW X,Y,DMAX
  1. D BMES^XPDUTL(" STEP 3 of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Recompiling Input Templates for Billing Screens 6, 7 & 8....")
  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. S X="IBXSC82",Y=$$FIND1^DIC(.402,,"X","IB SCREEN82","B"),DMAX=8000
  1. I Y D EN^DIEZ
  1. RITX ;
  1. D MES^XPDUTL(" Done.")
  1. D UPDATE^XPDID(3)
  1. Q
  1. ;
  1. DIC ; update some file descriptions with UB-04
  1. NEW UB82,UB04,FILE,Z,TEXT,NEWTEXT
  1. D BMES^XPDUTL(" STEP 4 of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Updating file descriptions for the UB-04 ....")
  1. ;
  1. S UB82="UB-82",UB04="UB-04"
  1. F FILE=353 S Z=0 F S Z=$O(^DIC(FILE,"%D",Z)) Q:'Z D
  1. . S TEXT=$G(^DIC(FILE,"%D",Z,0)) Q:TEXT'[UB82
  1. . S NEWTEXT=$P(TEXT,UB82,1)_UB04_$P(TEXT,UB82,2)
  1. . S ^DIC(FILE,"%D",Z,0)=NEWTEXT
  1. . Q
  1. ;
  1. D MES^XPDUTL(" Done.")
  1. D UPDATE^XPDID(4)
  1. DICX ;
  1. Q