Home Package List Routine Alphabetical List Global Alphabetical List FileMan Files List FileMan Sub-Files List Package Component Lists Package-Namespace Mapping
Routine: AZXRASU

AZXRASU.m

Go to the documentation of this file.

AZXRASU ;FIND ASUFAC CODES [ 08/04/93  10:17 AM ]

 S LOC=0

 F  S LOC=$O(^AUTTLOC(LOC)) Q:LOC=""  I $D(^AUTTLOC(LOC,"11",0)) I $P(^AUTTLOC(LOC,"11",0),U,4)>1 W !,"EXTRA ASUFAC CODES --> ",$P(^AUTTLOC(LOC,"11",0),U,4)," FOR ",LOC," LOCATION"

AZXRASU   ;FIND ASUFAC CODES [ 08/04/93  10:17 AM ]

 +1        SET LOC=0

 +2        FOR

               SET LOC=$ORDER(^AUTTLOC(LOC))

               IF LOC=""

                   QUIT

               IF $DATA(^AUTTLOC(LOC,"11",0))

                   IF $PIECE(^AUTTLOC(LOC,"11",0),U,4)>1

                       WRITE !,"EXTRA ASUFAC CODES --> ",$PIECE(^AUTTLOC(LOC,"11",0),U,4)," FOR ",LOC," LOCATION"