- 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 Feb 18, 2025@23:06:14 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