MCPOS09.m

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 ---MCPOS09   547     printed  Apr 09, 2024@21:15:17                                                                                                                                                                                                      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