source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPED1.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1GMRAPED1 ;HIRMFO/RM-EDIT DRUG CLASS FIELD ; 10/16/91
2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
3DRGCLS ; EDIT VA DRUG CLASS MULTIPLE
4 S GMRAB=$S($D(^GMR(120.8,GMRAPA,3,0)):$P(^(0),"^",3),1:""),GMRAB=$S($D(^GMR(120.8,GMRAPA,3,+GMRAB,0)):+^(0),1:0),GMRAB=$S($D(^PS(50.605,GMRAB,0)):$P(^(0),"^",2),1:"")
5RDCLS W !,"Select VA DRUG CLASS: ",$S(GMRAB'="":GMRAB_"// ",1:"") R X:DTIME S:'$T X="^^" I "^^"[X S:X'="" GMRAOUT=1 Q
6 I "@"[X W !,"YOU CAN NOT DELETE A VA DRUG CLASS.",$C(7)
7 S:X?1"?".E X="??" S:'$D(^GMR(120.8,GMRAPA,3,0)) ^(0)="^120.803PA^^" S DA(1)=GMRAPA,DIC="^GMR(120.8,"_GMRAPA_",3,"
8 S DIC("W")="N X S X=^(0) W ?$X+5,$S($D(^PS(50.605,+X,0)):$P(^(0),U,2),1:""""),@(""$E(""_DIC_Y_"",0),0)"")",DIC(0)="EMZ" K DTOUT,DUOUT D ^DIC K DIC
9 I +Y'>0 S:$D(DTOUT)!$D(DUOUT) GMRAOUT=1 Q:GMRAOUT G DGDIC
10YNLOK W !?4,Y(0,0)," OK" S %=1 D YN^DICN S:%=1 DA=+Y S:%=-1 GMRAOUT=1 Q:GMRAOUT G EDDC:%=1 I '% W !?7,"ANSWER YES IF THIS ENTRY IS OK, ELSE ANSWER NO." G YNLOK
11DGDIC S:X?1"?".E X="?" S DIC="^PS(50.605,",DIC(0)="EQMZ",DIC("W")="W ?$X+5,$P(^(0),U,2)" K DTOUT,DUOUT D ^DIC K DIC I +Y'>0 S:$D(DTOUT)!$D(DUOUT) GMRAOUT=1 Q:GMRAOUT G RDCLS
12 S DA(1)=GMRAPA,DA=$O(^GMR(120.8,GMRAPA,3,"B",+Y,0)) I DA'>0 D S DA=+Y G:DA'>0 RDCLS
13 .S DIC="^GMR(120.8,"_GMRAPA_",3,",DLAYGO=120.8,DIC(0)="EQL",X=$P(Y(0),"^") D ^DIC K DIC,DLAYGO
14 .Q
15EDDC S DIE="^GMR(120.8,"_GMRAPA_",3,",DR=".01 VA DRUG CLASS" D ^DIE S:$D(Y) GMRAOUT=1 S GMRAB=""
16 Q:GMRAOUT G RDCLS
Note: See TracBrowser for help on using the repository browser.