Routine: IBYSC

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")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYSC   877     printed  Mar 13, 2025@21:42:12                                                                                                                                                                                                        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

IBYSC.m