MCPOS09 ;HIRMFO/DAD-MOVE MICRO DESC REMARKS INTO WP FIELD ;5/31/96 12:48
;;2.3;Medicine;;09/13/1996
;
N MCD0,MCDATA
S MCDATA(1)=""
S MCDATA(2)="Moving Micro Description Remarks from a free text field"
S MCDATA(3)="to word processing field in the Hematology file (#694)."
D MES^XPDUTL(.MCDATA)
;
S MCD0=0
F S MCD0=$O(^MCAR(694,MCD0)) Q:MCD0'>0 D
. S MCDATA=$P($G(^MCAR(694,MCD0,7)),U)
. K ^MCAR(694,MCD0,7)
. I MCDATA="" Q
. S ^MCAR(694,MCD0,7,0)="^^1^1^"_$$DT^XLFDT_"^"
. S ^MCAR(694,MCD0,7,1,0)=MCDATA
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS09 547 printed Dec 13, 2024@02:16:30 Page 2
MCPOS09 ;HIRMFO/DAD-MOVE MICRO DESC REMARKS INTO WP FIELD ;5/31/96 12:48
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 NEW MCD0,MCDATA
+4 SET MCDATA(1)=""
+5 SET MCDATA(2)="Moving Micro Description Remarks from a free text field"
+6 SET MCDATA(3)="to word processing field in the Hematology file (#694)."
+7 DO MES^XPDUTL(.MCDATA)
+8 ;
+9 SET MCD0=0
+10 FOR
SET MCD0=$ORDER(^MCAR(694,MCD0))
if MCD0'>0
QUIT
Begin DoDot:1
+11 SET MCDATA=$PIECE($GET(^MCAR(694,MCD0,7)),U)
+12 KILL ^MCAR(694,MCD0,7)
+13 IF MCDATA=""
QUIT
+14 SET ^MCAR(694,MCD0,7,0)="^^1^1^"_$$DT^XLFDT_"^"
+15 SET ^MCAR(694,MCD0,7,1,0)=MCDATA
+16 QUIT
End DoDot:1
+17 QUIT
