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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPRE03 975 printed Oct 16, 2024@18:17:16 Page 2
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
