[613] | 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
|
---|