VistA-WorldVistAEHR/r/MEDICINE-MC/MCPOS07.m

27 lines
607 B
Mathematica

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