AGADFIX.m

AGADFIX ; IHS/ASDS/EFG - FIX AGADLIST 9009065.05 ZERO NODE DD NUMBERS ; 

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

 ;one time utility to reset 2nd piece of zero node of field 5

 ;to 9009065.05P

 D DT^DICRW

 Q:'$D(^AGADLIST)

 W !,"Correcting the data structure in the Registration Mailing List File",!

 S AGIEN=0 F  S AGIEN=$O(^AGADLIST(AGIEN)) Q:'AGIEN  I $D(^AGADLIST(AGIEN,1,0)) S $P(^(0),"^",2)="9009065.05P" K ^AGADLIST(AGIEN,1,"B"),^("C")

 S DIK="^AGADLIST(" D IXALL^DIK

 K AGIEN

 Q

AGADFIX   ; IHS/ASDS/EFG - FIX AGADLIST 9009065.05 ZERO NODE DD NUMBERS ; 

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

 +3       ;one time utility to reset 2nd piece of zero node of field 5

 +4       ;to 9009065.05P

 +5        DO DT^DICRW

 +6        IF '$DATA(^AGADLIST)

               QUIT 

 +7        WRITE !,"Correcting the data structure in the Registration Mailing List File",!

 +8        SET AGIEN=0

           FOR 

               SET AGIEN=$ORDER(^AGADLIST(AGIEN))

               IF 'AGIEN

                   QUIT 

               IF $DATA(^AGADLIST(AGIEN,1,0))

                   SET $PIECE(^(0),"^",2)="9009065.05P"

                   KILL ^AGADLIST(AGIEN,1,"B"),^("C")

 +9        SET DIK="^AGADLIST("

           DO IXALL^DIK

 +10       KILL AGIEN

 +11       QUIT