MCPOS07.m

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

 Q

 ;

FILEFLD ;; File # ^ Field #

 ;;693.5^1

 ;;695.3^1

 ;;695.5^1

 ;;695.9^1

 ;;696^2

 ;;696.2^1

 ;;697^2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MCPOS07   633     printed  Apr 09, 2024@21:15:49                                                                                                                                                                                                      Page 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