Routine: MCPOS07

MCPOS07 ;HIRMFO/DAD-DELETE POINTERS TO LAB FILES ;8/2/96  10:32

 ;;2.3;Medicine;;09/13/1996

 N DA,DIE,DR,MCD0,MCDATA,MCFIELD,MCFILE,MCOFFSET

 S MCDATA(1)=""

 S MCDATA(2)="Deleting pointers to Lab files."

 D MES^XPDUTL(.MCDATA) K MCDATA

 F MCOFFSET=1:1 S MCDATA=$P($T(FILEFLD+MCOFFSET),";",3) Q:MCDATA=""  D

 . S MCFILE=$P(MCDATA,U),MCFIELD=$P(MCDATA,U,2)

 . S MCD0=0

 . F  S MCD0=$O(^MCAR(MCFILE,MCD0)) Q:MCD0'>0  D

 .. S DIE="^MCAR("_MCFILE_",",DA=MCD0,DR=MCFIELD_"///@"

 .. D ^DIE

 .. Q

. Q

FILEFLD ;; File # ^ Field #

 ;;693.5^1

 ;;695.3^1

 ;;695.5^1

 ;;695.9^1

 ;;696^2

 ;;696.2^1

 ;;697^2

MCPOS07   ;HIRMFO/DAD-DELETE POINTERS TO LAB FILES ;8/2/96  10:32

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3        NEW DA,DIE,DR,MCD0,MCDATA,MCFIELD,MCFILE,MCOFFSET

 +4        SET MCDATA(1)=""

 +5        SET MCDATA(2)="Deleting pointers to Lab files."

 +6        DO MES^XPDUTL(.MCDATA)

           KILL MCDATA

 +7       ;

 +8        FOR MCOFFSET=1:1

               SET MCDATA=$PIECE($TEXT(FILEFLD+MCOFFSET),";",3)

               IF MCDATA=""

                   QUIT

               Begin DoDot:1

 +9                SET MCFILE=$PIECE(MCDATA,U)

                   SET MCFIELD=$PIECE(MCDATA,U,2)

 +10               SET MCD0=0

 +11               FOR

                       SET MCD0=$ORDER(^MCAR(MCFILE,MCD0))

                       IF MCD0'>0

                           QUIT

                       Begin DoDot:2

 +12                       SET DIE="^MCAR("_MCFILE_","

                           SET DA=MCD0

                           SET DR=MCFIELD_"///@"

 +13                       DO ^DIE

 +14                       QUIT

                       End DoDot:2

 +15               QUIT

               End DoDot:1

 +16       QUIT

 +17      ;

FILEFLD   ;; File # ^ Field #

 +1       ;;693.5^1

 +2       ;;695.3^1

 +3       ;;695.5^1

 +4       ;;695.9^1

 +5       ;;696^2

 +6       ;;696.2^1

 +7       ;;697^2

MCPOS07.m