source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARSUP.m@ 1036

Last change on this file since 1036 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.7 KB
Line 
1MCARSUP ;WISC/TJK-MEDICINE PACKAGE MANAGEMENT OPTIONS ;7/2/92 10:23
2V ;;2.3;Medicine;;09/13/1996
3EN1 ;
41 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
5 W !,*7,"Drug marked as a ",$S(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")," Drug" G 1
6EN2 ;
72 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
8EN3 ;
93 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
10DEL K DIC,DA,DLAYGO,DIR
11 S DA(1)=+Y
12 S DIR("A",1)="Drug already marked as a "_$S(MCARCODE="G":"GI",MCARCODE="P":"PULMONARY",MCARCODE="R":"RHEUMATOLOGY",1:"CARDIOLOGY")_" Drug."
13 S DIR("A")="Do you wish to delete it",DIR("B")="N",DIR(0)="Y"
14 D ^DIR
15 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"
16 G 1
17OUT1 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
18HELP ;DISPLAY LIST OF DRUGS ALREADY MARKED
19 IF $D(^MCAR(695,"C",$G(MCARCODE,U))) D ;JCC,5/15/96
20 . S DIR("A")="Do you wish to see list of drugs already marked for this area of Medicine"
21 . S DIR("B")="N",DIR(0)="Y"
22 . D ^DIR
23 . IF Y D
24 .. W !!,"Drugs already marked for this area of Medicine: ",!
25 .. 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)
26 .. Q
27 . ;END IF
28 . ;
29 . Q
30 ;END IF
31 ;
32 Q
Note: See TracBrowser for help on using the repository browser.