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