IBYSC.m

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 ---IBYSC   877     printed  Apr 09, 2024@21:06:54                                                                                                                                                                                                        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