25 lines
801 B
Mathematica
25 lines
801 B
Mathematica
MCPOS03 ;HIRMFO/DAD-INSTRUMENT FLAT-->MULT CONVERSION FILE #699 ;5/31/96 13:36
|
|
;;2.3;Medicine;;09/13/1996
|
|
;
|
|
N D0,DA,DD,DIC,DINUM,DLAYGO,DO,MCARCODE,MCD0,MCDATA,MCINSTR
|
|
S MCDATA(1)=""
|
|
S MCDATA(2)="Moving instrument from flat field into multiple"
|
|
S MCDATA(3)="in the Endoscopy/Consult file (#699)."
|
|
D MES^XPDUTL(.MCDATA)
|
|
;
|
|
S MCD0=0
|
|
F S MCD0=$O(^MCAR(699,MCD0)) Q:MCD0'>0 D
|
|
. S MCINSTR=+$P($G(^MCAR(699,MCD0,0)),U,7)
|
|
. I MCINSTR'>0 Q
|
|
. S $P(^MCAR(699,MCD0,0),U,7)=""
|
|
. I $O(^MCAR(699,MCD0,34,"B",MCINSTR,0)) Q
|
|
. S MCINSTR(0)=$G(^MCAR(699.48,MCINSTR,0))
|
|
. I $P(MCINSTR(0),U)="" Q
|
|
. K DD,DIC,DINUM,DO
|
|
. S DIC="^MCAR(699,"_MCD0_",34,",DIC(0)="M",DLAYGO=699
|
|
. S DIC("P")=$$GET1^DID(699,4,"","SPECIFIER")
|
|
. S (D0,DA(1))=MCD0,X=MCINSTR,MCARCODE=$P(MCINSTR(0),U,2)
|
|
. D FILE^DICN
|
|
. Q
|
|
Q
|