GMRAPED1 ;HIRMFO/RM-EDIT DRUG CLASS FIELD ;11/16/07 10:06
;;4.0;Adverse Reaction Tracking;**41**;Mar 29, 1996;Build 8
;DBIA Section
;PSN50P65 - 4543
;XLFDT - 10103
;PSNDI - 4554
;DIC - 10006
;DIE - 10018
DRGCLS ; EDIT VA DRUG CLASS MULTIPLE
K ^TMP($J,"GMRACLASS") ;41 clean out before using
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) D C^PSN50P65(GMRAB,,"GMRACLASS") S GMRAB=$S($D(^TMP($J,"GMRACLASS",GMRAB,1)):$P(^(1),U),1:"") ;41 added C^PSN50P65
RDCLS W !,"Select VA DRUG CLASS: ",$S(GMRAB'="":GMRAB_"// ",1:"") R X:DTIME S:'$T X="^^" I "^^"[X S:X'="" GMRAOUT=1 Q
I "@"[X W !,"YOU CAN NOT DELETE A VA DRUG CLASS.",$C(7)
S:'$D(^GMR(120.8,GMRAPA,3,0)) ^(0)="^120.803PA^^" ;41 separated out command
I X?1"?".E D W ! ;41 List existing drug class for allergy, entire section added w/ patch 41
.N SUB,IEN K ^TMP($J,"GMRACLASS")
.I $O(^GMR(120.8,GMRAPA,3,0)) W !!?3,"Choose from:",!
.S SUB=0 F S SUB=$O(^GMR(120.8,GMRAPA,3,SUB)) Q:'+SUB S IEN=^(SUB,0) D C^PSN50P65(IEN,,"GMRACLASS") W !,?3,$G(^TMP($J,"GMRACLASS",IEN,.01)),?$X+5,$G(^TMP($J,"GMRACLASS",IEN,1))
DGDIC 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^PSNDI(50.605,"GMRA",.DIC,.X,,$$DT^XLFDT) K DIC I +Y'>0 G RDCLS ;41
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
.S DIC="^GMR(120.8,"_GMRAPA_",3,",DLAYGO=120.8,DIC(0)="EQL",X=$P(Y(0),"^") D ^DIC K DIC,DLAYGO
.Q
EDDC S DIE="^GMR(120.8,"_GMRAPA_",3,",DR=".01 VA DRUG CLASS" D ^DIE S:$D(Y) GMRAOUT=1 S GMRAB=""
Q:GMRAOUT G RDCLS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPED1 1665 printed Oct 16, 2024@17:40:43 Page 2
GMRAPED1 ;HIRMFO/RM-EDIT DRUG CLASS FIELD ;11/16/07 10:06
+1 ;;4.0;Adverse Reaction Tracking;**41**;Mar 29, 1996;Build 8
+2 ;DBIA Section
+3 ;PSN50P65 - 4543
+4 ;XLFDT - 10103
+5 ;PSNDI - 4554
+6 ;DIC - 10006
+7 ;DIE - 10018
DRGCLS ; EDIT VA DRUG CLASS MULTIPLE
+1 ;41 clean out before using
KILL ^TMP($JOB,"GMRACLASS")
+2 ;41 added C^PSN50P65
SET GMRAB=$SELECT($DATA(^GMR(120.8,GMRAPA,3,0)):$PIECE(^(0),"^",3),1:"")
SET GMRAB=$SELECT($DATA(^GMR(120.8,GMRAPA,3,+GMRAB,0)):+^(0),1:0)
DO C^PSN50P65(GMRAB,,"GMRACLASS")
SET GMRAB=$SELECT($DATA(^TMP($JOB,"GMRACLASS",GMRAB,1)):$PIECE(^(1),U),1:"")
RDCLS WRITE !,"Select VA DRUG CLASS: ",$SELECT(GMRAB'="":GMRAB_"// ",1:"")
READ X:DTIME
if '$TEST
SET X="^^"
IF "^^"[X
if X'=""
SET GMRAOUT=1
QUIT
+1 IF "@"[X
WRITE !,"YOU CAN NOT DELETE A VA DRUG CLASS.",$CHAR(7)
+2 ;41 separated out command
if '$DATA(^GMR(120.8,GMRAPA,3,0))
SET ^(0)="^120.803PA^^"
+3 ;41 List existing drug class for allergy, entire section added w/ patch 41
IF X?1"?".E
Begin DoDot:1
+4 NEW SUB,IEN
KILL ^TMP($JOB,"GMRACLASS")
+5 IF $ORDER(^GMR(120.8,GMRAPA,3,0))
WRITE !!?3,"Choose from:",!
+6 SET SUB=0
FOR
SET SUB=$ORDER(^GMR(120.8,GMRAPA,3,SUB))
if '+SUB
QUIT
SET IEN=^(SUB,0)
DO C^PSN50P65(IEN,,"GMRACLASS")
WRITE !,?3,$GET(^TMP($JOB,"GMRACLASS",IEN,.01)),?$X+5,$GET(^TMP($JOB,"GMRACLASS",IEN,1))
End DoDot:1
WRITE !
DGDIC ;41
if X?1"?".E
SET X="?"
SET DIC="^PS(50.605,"
SET DIC(0)="EQMZ"
SET DIC("W")="W ?$X+5,$P(^(0),U,2)"
KILL DTOUT,DUOUT
DO DIC^PSNDI(50.605,"GMRA",.DIC,.X,,$$DT^XLFDT)
KILL DIC
IF +Y'>0
GOTO RDCLS
+1 SET DA(1)=GMRAPA
SET DA=$ORDER(^GMR(120.8,GMRAPA,3,"B",+Y,0))
IF DA'>0
Begin DoDot:1
+2 SET DIC="^GMR(120.8,"_GMRAPA_",3,"
SET DLAYGO=120.8
SET DIC(0)="EQL"
SET X=$PIECE(Y(0),"^")
DO ^DIC
KILL DIC,DLAYGO
+3 QUIT
End DoDot:1
SET DA=+Y
if DA'>0
GOTO RDCLS
EDDC SET DIE="^GMR(120.8,"_GMRAPA_",3,"
SET DR=".01 VA DRUG CLASS"
DO ^DIE
if $DATA(Y)
SET GMRAOUT=1
SET GMRAB=""
+1 if GMRAOUT
QUIT
GOTO RDCLS
