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