- 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
- 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