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

MCARSUP.m

Go to the documentation of this file.
  1. MCARSUP ;WISC/TJK-MEDICINE PACKAGE MANAGEMENT OPTIONS ;7/2/92 10:23
  1. V ;;2.3;Medicine;;09/13/1996
  1. EN1 ;
  1. 1 Q:'$D(MCARCODE) S DIC="^MCAR(695,",DLAYGO=695,DIC(0)="AEQLM" D ^DIC G OUT1:Y<0 S DA=+Y G DEL:$D(^MCAR(695,"C",MCARCODE,+Y)) S DR="1///"_MCARCODE,DIE=DIC K DIC,DLAYGO D ^DIE K DIE,DA,DR
  1. W !,*7,"Drug marked as a ",$S(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")," Drug" G 1
  1. EN2 ;
  1. 2 S DIC="^MCAR(693.6,",(DIDEL,DLAYGO)=693.6,DIC(0)="AEQLM" D ^DIC G OUT1:Y<0 S DA=+Y,DR=.01,DIE=DIC K DIC,DLAYGO D ^DIE K DA,DIE,DR G 2
  1. EN3 ;
  1. 3 Q:'$D(DIC) S MCDICS=DIC("S"),DIC(0)="AEQLM" D ^DIC G OUT1:Y<0 S DA=+Y,DR=.01,DIE=DIC,DIDEL=DLAYGO D ^DIE K DA S DIC("S")=MCDICS G 3
  1. DEL K DIC,DA,DLAYGO,DIR
  1. S DA(1)=+Y
  1. S DIR("A",1)="Drug already marked as a "_$S(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")_" Drug."
  1. S DIR("A")="Do you wish to delete it",DIR("B")="N",DIR(0)="Y"
  1. D ^DIR
  1. I Y S DA=$O(^MCAR(695,"C",MCARCODE,DA(1),0)),DIK="^MCAR(695,"_DA(1)_",1," D ^DIK K DA,DIK,%,Y,X W !!,"Deleted"
  1. G 1
  1. OUT1 K %,%H,C,D0,DI,DIG,DIH,DIU,DIV,DIW,DQ,I,Z,Y,X,DIC,DLAYGO,DIE,MCARCODE,%Y,DR,DQ,D1,%Y1,%Y2,DICMX,DIPGM,DIXX,VA,DIDEL,MCDICS Q
  1. HELP ;DISPLAY LIST OF DRUGS ALREADY MARKED
  1. IF $D(^MCAR(695,"C",$G(MCARCODE,U))) D ;JCC,5/15/96
  1. . S DIR("A")="Do you wish to see list of drugs already marked for this area of Medicine"
  1. . S DIR("B")="N",DIR(0)="Y"
  1. . D ^DIR
  1. . IF Y D
  1. .. W !!,"Drugs already marked for this area of Medicine: ",!
  1. .. F I=0:0 S I=$O(^MCAR(695,"C",MCARCODE,I)) Q:I="" W:$X>50 ! W $E($P(^PSDRUG(I,0),U)_" ",1,40)
  1. .. Q
  1. . ;END IF
  1. . ;
  1. . Q
  1. ;END IF
  1. ;
  1. Q