| 1 | MCPRE03 ;HISC/DAD-REMOVE 'M' FROM APPLICATION PACKAGES' USE FIELD (50,63) ;4/22/96  15:50
 | 
|---|
| 2 |  ;;2.3;Medicine;;09/13/1996
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  N DIR,DIRUT,DTOUT,DUOUT,MCD0,MCDRUG,MCOUNT,MCPRE005,MCQUEUE,MCTEXT
 | 
|---|
| 5 |  N PSIUDA,PSIUX,ZTDESC,ZTIO,ZTRTN,ZTSK,X,Y
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  S MCTEXT(1)=""
 | 
|---|
| 8 |  S MCTEXT(2)="Removing the 'M's from the APPLICATION PACKAGES' USE"
 | 
|---|
| 9 |  S MCTEXT(3)="field (#63) of the DRUG file (#50)."
 | 
|---|
| 10 |  D MES^XPDUTL(.MCTEXT) K MCTEXT
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 |  S MCDRUG="",MCOUNT=6
 | 
|---|
| 13 |  F  S MCDRUG=$O(^PSDRUG("AIUM",MCDRUG)) Q:MCDRUG=""  D
 | 
|---|
| 14 |  . S MCD0=0
 | 
|---|
| 15 |  . F  S MCD0=$O(^PSDRUG("AIUM",MCDRUG,MCD0)) Q:MCD0'>0  D
 | 
|---|
| 16 |  .. S PSIUDA=MCD0,PSIUX="M"
 | 
|---|
| 17 |  .. D END^PSGIU
 | 
|---|
| 18 |  .. S MCOUNT=MCOUNT+1,MCPRE005(MCOUNT)=MCDRUG
 | 
|---|
| 19 |  .. Q
 | 
|---|
| 20 |  . Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 |  S MCPRE005(1)=""
 | 
|---|
| 23 |  S MCPRE005(2)="The clean-up of the Medicine entries (M) in"
 | 
|---|
| 24 |  S MCPRE005(3)="the APPLICATION PACKAGES' USE field (#63) in"
 | 
|---|
| 25 |  S MCPRE005(4)="the DRUG file (#50) is finished."
 | 
|---|
| 26 |  S MCPRE005(5)="Entries cleaned-up: "_(MCOUNT-6)_"."
 | 
|---|
| 27 |  S MCPRE005(6)=""
 | 
|---|
| 28 |  D MES^XPDUTL(.MCPRE005)
 | 
|---|
| 29 |  Q
 | 
|---|