Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MCPRE03

MCPRE03.m

Go to the documentation of this file.
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)
 Q