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 ---[H[J[2J[HIB20P481 1498 printed Oct 16, 2024@18:03:53 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
