MCARSUP.m

MCARSUP ;WISC/TJK-MEDICINE PACKAGE MANAGEMENT OPTIONS ;7/2/92  10:23

V ;;2.3;Medicine;;09/13/1996

EN1 ;

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

 W !,*7,"Drug marked as a ",$S(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")," Drug" G 1

EN2 ;

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

EN3 ;

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

DEL K DIC,DA,DLAYGO,DIR

 S DA(1)=+Y

 S DIR("A",1)="Drug already marked as a "_$S(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")_" Drug."

 S DIR("A")="Do you wish to delete it",DIR("B")="N",DIR(0)="Y"

 D ^DIR

 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"

 G 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

HELP ;DISPLAY LIST OF DRUGS ALREADY MARKED

 IF $D(^MCAR(695,"C",$G(MCARCODE,U))) D  ;JCC,5/15/96

 .  S DIR("A")="Do you wish to see list of drugs already marked for this area of Medicine"

 .  S DIR("B")="N",DIR(0)="Y"

 .  D ^DIR

 .  IF Y D

 ..    W !!,"Drugs already marked for this area of Medicine: ",!

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

 ..    Q

 .  ;END IF

 .  ;

 .  Q

 ;END IF

 ;

 Q

MCARSUP   ;WISC/TJK-MEDICINE PACKAGE MANAGEMENT OPTIONS ;7/2/92  10:23

V         ;;2.3;Medicine;;09/13/1996

EN1       ;

1          IF '$DATA(MCARCODE)

               QUIT 

           SET DIC="^MCAR(695,"

           SET DLAYGO=695

           SET DIC(0)="AEQLM"

           DO ^DIC

           IF Y<0

               GOTO OUT1

           SET DA=+Y

           IF $DATA(^MCAR(695,"C",MCARCODE,+Y))

               GOTO DEL

           SET DR="1///"_MCARCODE

           SET DIE=DIC

           KILL DIC,DLAYGO

           DO ^DIE

           KILL DIE,DA,DR

 +1        WRITE !,*7,"Drug marked as a ",$SELECT(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")," Drug"

           GOTO 1

EN2       ;

2          SET DIC="^MCAR(693.6,"

           SET (DIDEL,DLAYGO)=693.6

           SET DIC(0)="AEQLM"

           DO ^DIC

           IF Y<0

               GOTO OUT1

           SET DA=+Y

           SET DR=.01

           SET DIE=DIC

           KILL DIC,DLAYGO

           DO ^DIE

           KILL DA,DIE,DR

           GOTO 2

EN3       ;

3          IF '$DATA(DIC)

               QUIT 

           SET MCDICS=DIC("S")

           SET DIC(0)="AEQLM"

           DO ^DIC

           IF Y<0

               GOTO OUT1

           SET DA=+Y

           SET DR=.01

           SET DIE=DIC

           SET DIDEL=DLAYGO

           DO ^DIE

           KILL DA

           SET DIC("S")=MCDICS

           GOTO 3

DEL        KILL DIC,DA,DLAYGO,DIR

 +1        SET DA(1)=+Y

 +2        SET DIR("A",1)="Drug already marked as a "_$SELECT(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")_" Drug."

 +3        SET DIR("A")="Do you wish to delete it"

           SET DIR("B")="N"

           SET DIR(0)="Y"

 +4        DO ^DIR

 +5        IF Y

               SET DA=$ORDER(^MCAR(695,"C",MCARCODE,DA(1),0))

               SET DIK="^MCAR(695,"_DA(1)_",1,"

               DO ^DIK

               KILL DA,DIK,%,Y,X

               WRITE !!,"Deleted"

 +6        GOTO 1

OUT1       KILL %,%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

           QUIT 

HELP      ;DISPLAY LIST OF DRUGS ALREADY MARKED

 +1       ;JCC,5/15/96

           IF $DATA(^MCAR(695,"C",$GET(MCARCODE,U)))

               Begin DoDot:1

 +2                SET DIR("A")="Do you wish to see list of drugs already marked for this area of Medicine"

 +3                SET DIR("B")="N"

                   SET DIR(0)="Y"

 +4                DO ^DIR

 +5                IF Y

                       Begin DoDot:2

 +6                        WRITE !!,"Drugs already marked for this area of Medicine: ",!

 +7                        FOR I=0:0

                               SET I=$ORDER(^MCAR(695,"C",MCARCODE,I))

                               IF I=""

                                   QUIT 

                               IF $X>50

                                   WRITE !

                               WRITE $EXTRACT($PIECE(^PSDRUG(I,0),U)_"                                        ",1,40)

 +8                        QUIT 

                       End DoDot:2

 +9       ;END IF

 +10      ;

 +11               QUIT 

               End DoDot:1

 +12      ;END IF

 +13      ;

 +14       QUIT