IB20P481.m

IB20P481 ;ALB/RDK - IB*2.0*481; UNSUPPORTED GLOBAL READS ; 4/2/13 8:55am

 ;;2.0;INTEGRATED BILLING;**481**;21-MAR-94;Build 3

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 Q

EN ;

 N DIK,DA,N,X,Y,DMAX,IBIEN,I

 D START,NULL64,DELDD,RECOMP,FINISH

 Q

 ;

 ;ICR 5907 - Delete Field #64 from file #399.

NULL64 ;NULL OUT VALUES FOR FIELD #64 IN FILE #399

 W !!,">>> Setting all values of field (#64) in file (#399) to null. <<<",!,">>> This may take a while, depending on how many bills are in <<<"

 W !,">>> the Bill/Claims file.  Please be patient.                 <<<"

 S IBIEN="" F I=1:1 S IBIEN=$O(^DGCR(399,IBIEN)) Q:IBIEN'?1N.N  I $D(^DGCR(399,IBIEN,"C")),$P(^DGCR(399,IBIEN,"C"),U,14)'="" S $P(^DGCR(399,IBIEN,"C"),U,14)=""

 W !!,">>> All values for field (#64) have been set to null. <<<"

 Q

DELDD ;DELETE FIELD #64 FROM FILE #399 IN DATA DICTIONARY

 W !!,">>> Deleting field (#64) from file (#399) in Data Dictionary. <<<"

 S DIK="^DD(399,",DA=64,DA(1)=399

 D ^DIK

 W !!,">>> Deletion from Data Dictionary complete. <<<"

 Q

RECOMP ;RECOMPILE CROSS REFERENCE ROUTINES

 W !!,">>> Recompiling cross reference routines for BILL/CLAIMS file. <<<"

 S (N,Y)=399 W ! I $D(^DD(N,0,"DIK"))#2 S X=^DD(N,0,"DIK"),DMAX=^DD("ROU") W !,"** File "_N_" **",! D EN^DIKZ

 W !!,">>> Recompile complete. <<<"

 Q

START ;PROCEDURE START MESSAGE

 W !!,"*** Procedure initiating. ***"

 Q

FINISH ;PROCEDURE COMPLETE MESSAGE

 W !!,"*** Procedure complete. ***"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IB20P481   1498     printed  Apr 23, 2025@18:17:39                                                                                                                                                                                                    Page 2

IB20P481  ;ALB/RDK - IB*2.0*481; UNSUPPORTED GLOBAL READS ; 4/2/13 8:55am

 +1       ;;2.0;INTEGRATED BILLING;**481**;21-MAR-94;Build 3

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4        QUIT 

EN        ;

 +1        NEW DIK,DA,N,X,Y,DMAX,IBIEN,I

 +2        DO START

           DO NULL64

           DO DELDD

           DO RECOMP

           DO FINISH

 +3        QUIT 

 +4       ;

 +5       ;ICR 5907 - Delete Field #64 from file #399.

NULL64    ;NULL OUT VALUES FOR FIELD #64 IN FILE #399

 +1        WRITE !!,">>> Setting all values of field (#64) in file (#399) to null. <<<",!,">>> This may take a while, depending on how many bills are in <<<"

 +2        WRITE !,">>> the Bill/Claims file.  Please be patient.                 <<<"

 +3        SET IBIEN=""

           FOR I=1:1

               SET IBIEN=$ORDER(^DGCR(399,IBIEN))

               if IBIEN'?1N.N

                   QUIT 

               IF $DATA(^DGCR(399,IBIEN,"C"))

                   IF $PIECE(^DGCR(399,IBIEN,"C"),U,14)'=""

                       SET $PIECE(^DGCR(399,IBIEN,"C"),U,14)=""

 +4        WRITE !!,">>> All values for field (#64) have been set to null. <<<"

 +5        QUIT 

DELDD     ;DELETE FIELD #64 FROM FILE #399 IN DATA DICTIONARY

 +1        WRITE !!,">>> Deleting field (#64) from file (#399) in Data Dictionary. <<<"

 +2        SET DIK="^DD(399,"

           SET DA=64

           SET DA(1)=399

 +3        DO ^DIK

 +4        WRITE !!,">>> Deletion from Data Dictionary complete. <<<"

 +5        QUIT 

RECOMP    ;RECOMPILE CROSS REFERENCE ROUTINES

 +1        WRITE !!,">>> Recompiling cross reference routines for BILL/CLAIMS file. <<<"

 +2        SET (N,Y)=399

           WRITE !

           IF $DATA(^DD(N,0,"DIK"))#2

               SET X=^DD(N,0,"DIK")

               SET DMAX=^DD("ROU")

               WRITE !,"** File "_N_" **",!

               DO EN^DIKZ

 +3        WRITE !!,">>> Recompile complete. <<<"

 +4        QUIT 

START     ;PROCEDURE START MESSAGE

 +1        WRITE !!,"*** Procedure initiating. ***"

 +2        QUIT 

FINISH    ;PROCEDURE COMPLETE MESSAGE

 +1        WRITE !!,"*** Procedure complete. ***"

 +2        QUIT