ACPT27P2.m

ACPT27P2 ;IHS/SD/SDR - CPT 2.07 FIX ROUTINE - 10/1/2007 7:29:24 AM

 ;;2.08;CPT FILES;;DEC 17, 2007

 ;

 ;

 S ACPTIEN=0

 F  S ACPTIEN=$O(^ICPT(ACPTIEN)) Q:ACPTIEN=0  D

 .I ACPTIEN'="",(+ACPTIEN'=$G(ACPTIEN)),($P($G(^ICPT(ACPTIEN,0)),U)="") D

 ..Q:(ACPTIEN="BA")!(ACPTIEN="C")!(ACPTIEN="D")!(ACPTIEN="I")  ;cross references

 ..Q:(ACPTIEN="B")&('$D(^ICPT(ACPTIEN,0)))  ;entries that look like ^ICPT("B",0)

 ..W !,ACPTIEN,?10,$G(^ICPT(ACPTIEN,0))

 ..K ^ICPT(ACPTIEN,0)

 Q

ACPT27P2  ;IHS/SD/SDR - CPT 2.07 FIX ROUTINE - 10/1/2007 7:29:24 AM

 +1       ;;2.08;CPT FILES;;DEC 17, 2007

 +2       ;

 +3       ;

 +4        SET ACPTIEN=0

 +5        FOR 

               SET ACPTIEN=$ORDER(^ICPT(ACPTIEN))

               IF ACPTIEN=0

                   QUIT 

               Begin DoDot:1

 +6                IF ACPTIEN'=""

                       IF (+ACPTIEN'=$GET(ACPTIEN))

                           IF ($PIECE($GET(^ICPT(ACPTIEN,0)),U)="")

                               Begin DoDot:2

 +7       ;cross references

                                   IF (ACPTIEN="BA")!(ACPTIEN="C")!(ACPTIEN="D")!(ACPTIEN="I")

                                       QUIT 

 +8       ;entries that look like ^ICPT("B",0)

                                   IF (ACPTIEN="B")&('$DATA(^ICPT(ACPTIEN,0)))

                                       QUIT 

 +9                                WRITE !,ACPTIEN,?10,$GET(^ICPT(ACPTIEN,0))

 +10                               KILL ^ICPT(ACPTIEN,0)

                               End DoDot:2

               End DoDot:1

 +11       QUIT