IBYSC ;ALB/ARH - IB*2*130 PRE INIT: REMOVE XREFS ; 4/20/00
;;2.0;INTEGRATED BILLING;**126**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
PRE ; PRE-INSTALL FOR IB*2*130
;
; delete cross references on some patient insurance fields (2,.312), they will be updated by the install
;
; the cross references on these fields were changed so they have to be removed before the new ones are added
;
N IBX,X,Y,DIK,DA,IBFLD,IBXREF
;
D BMES^XPDUTL("Pre-Installation Updates")
;
F IBFLD=.01,3,8 D
. ;
. S IBXREF=0 F S IBXREF=$O(^DD(2.312,IBFLD,1,IBXREF)) Q:'IBXREF D
.. ;
.. S DIK="^DD(2.312,"_IBFLD_",1,",DA(2)=2.312,DA(1)=IBFLD,DA=IBXREF
.. ;
.. D ^DIK K DIK,DA
;
D MES^XPDUTL(" * cross references deleted (will be updated during install)")
;
D MES^XPDUTL("Pre-Installation Updates Completed")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYSC 877 printed Dec 13, 2024@02:37 Page 2
IBYSC ;ALB/ARH - IB*2*130 PRE INIT: REMOVE XREFS ; 4/20/00
+1 ;;2.0;INTEGRATED BILLING;**126**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
PRE ; PRE-INSTALL FOR IB*2*130
+1 ;
+2 ; delete cross references on some patient insurance fields (2,.312), they will be updated by the install
+3 ;
+4 ; the cross references on these fields were changed so they have to be removed before the new ones are added
+5 ;
+6 NEW IBX,X,Y,DIK,DA,IBFLD,IBXREF
+7 ;
+8 DO BMES^XPDUTL("Pre-Installation Updates")
+9 ;
+10 FOR IBFLD=.01,3,8
Begin DoDot:1
+11 ;
+12 SET IBXREF=0
FOR
SET IBXREF=$ORDER(^DD(2.312,IBFLD,1,IBXREF))
if 'IBXREF
QUIT
Begin DoDot:2
+13 ;
+14 SET DIK="^DD(2.312,"_IBFLD_",1,"
SET DA(2)=2.312
SET DA(1)=IBFLD
SET DA=IBXREF
+15 ;
+16 DO ^DIK
KILL DIK,DA
End DoDot:2
End DoDot:1
+17 ;
+18 DO MES^XPDUTL(" * cross references deleted (will be updated during install)")
+19 ;
+20 DO MES^XPDUTL("Pre-Installation Updates Completed")
+21 QUIT
