Routine: MCPRE03

MCPRE03 ;HISC/DAD-REMOVE 'M' FROM APPLICATION PACKAGES' USE FIELD (50,63) ;4/22/96  15:50

 ;;2.3;Medicine;;09/13/1996

 N DIR,DIRUT,DTOUT,DUOUT,MCD0,MCDRUG,MCOUNT,MCPRE005,MCQUEUE,MCTEXT

 N PSIUDA,PSIUX,ZTDESC,ZTIO,ZTRTN,ZTSK,X,Y

 S MCTEXT(1)=""

 S MCTEXT(2)="Removing the 'M's from the APPLICATION PACKAGES' USE"

 S MCTEXT(3)="field (#63) of the DRUG file (#50)."

 D MES^XPDUTL(.MCTEXT) K MCTEXT

 S MCDRUG="",MCOUNT=6

 F  S MCDRUG=$O(^PSDRUG("AIUM",MCDRUG)) Q:MCDRUG=""  D

 . S MCD0=0

 . F  S MCD0=$O(^PSDRUG("AIUM",MCDRUG,MCD0)) Q:MCD0'>0  D

 .. S PSIUDA=MCD0,PSIUX="M"

 .. D END^PSGIU

 .. S MCOUNT=MCOUNT+1,MCPRE005(MCOUNT)=MCDRUG

 .. Q

. Q

 S MCPRE005(1)=""

 S MCPRE005(2)="The clean-up of the Medicine entries (M) in"

 S MCPRE005(3)="the APPLICATION PACKAGES' USE field (#63) in"

 S MCPRE005(4)="the DRUG file (#50) is finished."

 S MCPRE005(5)="Entries cleaned-up: "_(MCOUNT-6)_"."

 S MCPRE005(6)=""

 D MES^XPDUTL(.MCPRE005)

MCPRE03   ;HISC/DAD-REMOVE 'M' FROM APPLICATION PACKAGES' USE FIELD (50,63) ;4/22/96  15:50

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3        NEW DIR,DIRUT,DTOUT,DUOUT,MCD0,MCDRUG,MCOUNT,MCPRE005,MCQUEUE,MCTEXT

 +4        NEW PSIUDA,PSIUX,ZTDESC,ZTIO,ZTRTN,ZTSK,X,Y

 +5       ;

 +6        SET MCTEXT(1)=""

 +7        SET MCTEXT(2)="Removing the 'M's from the APPLICATION PACKAGES' USE"

 +8        SET MCTEXT(3)="field (#63) of the DRUG file (#50)."

 +9        DO MES^XPDUTL(.MCTEXT)

           KILL MCTEXT

 +10      ;

 +11       SET MCDRUG=""

           SET MCOUNT=6

 +12       FOR

               SET MCDRUG=$ORDER(^PSDRUG("AIUM",MCDRUG))

               IF MCDRUG=""

                   QUIT

               Begin DoDot:1

 +13               SET MCD0=0

 +14               FOR

                       SET MCD0=$ORDER(^PSDRUG("AIUM",MCDRUG,MCD0))

                       IF MCD0'>0

                           QUIT

                       Begin DoDot:2

 +15                       SET PSIUDA=MCD0

                           SET PSIUX="M"

 +16                       DO END^PSGIU

 +17                       SET MCOUNT=MCOUNT+1

                           SET MCPRE005(MCOUNT)=MCDRUG

 +18                       QUIT

                       End DoDot:2

 +19               QUIT

               End DoDot:1

 +20      ;

 +21       SET MCPRE005(1)=""

 +22       SET MCPRE005(2)="The clean-up of the Medicine entries (M) in"

 +23       SET MCPRE005(3)="the APPLICATION PACKAGES' USE field (#63) in"

 +24       SET MCPRE005(4)="the DRUG file (#50) is finished."

 +25       SET MCPRE005(5)="Entries cleaned-up: "_(MCOUNT-6)_"."

 +26       SET MCPRE005(6)=""

 +27       DO MES^XPDUTL(.MCPRE005)

 +28       QUIT

MCPRE03.m