- 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 Feb 19, 2025@00:00:17 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