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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS03 825 printed Nov 22, 2024@17:26:25 Page 2
MCPOS03 ;HIRMFO/DAD-INSTRUMENT FLAT-->MULT CONVERSION FILE #699 ;5/31/96 13:36
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 NEW D0,DA,DD,DIC,DINUM,DLAYGO,DO,MCARCODE,MCD0,MCDATA,MCINSTR
+4 SET MCDATA(1)=""
+5 SET MCDATA(2)="Moving instrument from flat field into multiple"
+6 SET MCDATA(3)="in the Endoscopy/Consult file (#699)."
+7 DO MES^XPDUTL(.MCDATA)
+8 ;
+9 SET MCD0=0
+10 FOR
SET MCD0=$ORDER(^MCAR(699,MCD0))
if MCD0'>0
QUIT
Begin DoDot:1
+11 SET MCINSTR=+$PIECE($GET(^MCAR(699,MCD0,0)),U,7)
+12 IF MCINSTR'>0
QUIT
+13 SET $PIECE(^MCAR(699,MCD0,0),U,7)=""
+14 IF $ORDER(^MCAR(699,MCD0,34,"B",MCINSTR,0))
QUIT
+15 SET MCINSTR(0)=$GET(^MCAR(699.48,MCINSTR,0))
+16 IF $PIECE(MCINSTR(0),U)=""
QUIT
+17 KILL DD,DIC,DINUM,DO
+18 SET DIC="^MCAR(699,"_MCD0_",34,"
SET DIC(0)="M"
SET DLAYGO=699
+19 SET DIC("P")=$$GET1^DID(699,4,"","SPECIFIER")
+20 SET (D0,DA(1))=MCD0
SET X=MCINSTR
SET MCARCODE=$PIECE(MCINSTR(0),U,2)
+21 DO FILE^DICN
+22 QUIT
End DoDot:1
+23 QUIT
