GMRAPED0 ;HIRMFO/RM,WAA-VERIFIER EDIT OF DRUG A/AR ;11/16/07 10:03
;;4.0;Adverse Reaction Tracking;**17,41**;Mar 29, 1996;Build 8
;DBIA Section
;PSN50P41 - 4531
;PSN50P65 - 4543
;DICN - 10009
;DIE - 10018
;XLFDT - 10103
EN1 ; ENTRY TO EDIT INFO SPECIFIC TO DRUG A/AR FOR VERIFIER
K GMRAINGR,GMRACLAS,^TMP($J,"GMRAING"),^TMP($J,"GMRADCL") ;41 Add ^TMP to list
I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) G Q1
S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) G:GMRAPA(0)="" Q1
F GMRAINGR=0:0 S GMRAINGR=$O(^GMR(120.8,GMRAPA,2,GMRAINGR)) Q:GMRAINGR'>0 D ;41 Added block structure
.S X=$S($D(^GMR(120.8,GMRAPA,2,GMRAINGR,0)):^(0),1:"") I +X>0 D ZERO^PSN50P41(+X,,$$DT^XLFDT,"GMRAING") S Y=$S($D(^TMP($J,"GMRAING",+X,.01)):^(.01),1:"") I $P(Y,U)'="" S GMRAINGR($P(Y,U),+X)=Y ;41 added call to ZERO
F GMRACLAS=0:0 S GMRACLAS=$O(^GMR(120.8,GMRAPA,3,GMRACLAS)) Q:GMRACLAS'>0 D ;41 Added dot structure
.S X=$S($D(^GMR(120.8,GMRAPA,3,GMRACLAS,0)):^(0),1:"") I +X>0 D C^PSN50P65(+X,,"GMRADCL") S Y=$S($D(^TMP($J,"GMRADCL",+X,.01)):^(.01)_U_$G(^(1)),1:"") I $P(Y,U)'="" S GMRACLAS($P(Y,U),+X)=Y ;41 Added call to C^PSN50P65
S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
W @IOF
W !,"CAUSATIVE AGENT: ",$P(GMRAPA(0),U,2)
W !?11,"TYPE: ",$$OUTTYPE^GMRAUTL($P(GMRAPA(0),U,20))
W !?4,"INGREDIENTS: " S Y="",GMRAPRSW=0 F S Y=$O(GMRAINGR(Y)) Q:Y="" F X=0:0 S X=$O(GMRAINGR(Y,X)) Q:X'>0 W:GMRAPRSW ! W ?17,Y S:'GMRAPRSW GMRAPRSW=1
W !,"VA DRUG CLASSES: "
S Y="",GMRAPRSW=0 F S Y=$O(GMRACLAS(Y)) Q:Y="" F X=0:0 S X=$O(GMRACLAS(Y,X)) Q:X'>0 W:GMRAPRSW ! W ?17,Y," - ",$P(GMRACLAS(Y,X),U,2) S:'GMRAPRSW GMRAPRSW=1
W !," OBS/HIST: ",$S($P(GMRAPA(0),U,6)="o":"OBSERVED",$P(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")
D ;Sign/Symptoms
.N GMRAVFY
.S GMRAVFY=1
.D EN1^GMRADSP3
.Q
W !," MECHANISM: ",$S($P(GMRAPA(0),U,14)="A":"ALLERGY",$P(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$P(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")
YNED W !!,"Would you like to edit any of this data" S %=0 D YN^DICN I '% W !?4,$C(7),"ANSWER YES IF YOU WISH TO CHANGE ANY OF THE DATA ABOVE, ELSE ANSWER NO." G YNED
S:%=-1 GMRAOUT=1 G Q1:%=2!GMRAOUT
D EN1^GMRAPED3 G:GMRAOUT Q1 I GMRAAR'="" S DIE="^GMR(120.8,",DA=GMRAPA,DR=".02////^S X=GMRAAR(0);1////^S X=GMRAAR"_$S($D(GMRAAR("O")):";3.1////"_GMRAAR("O"),1:"") D ^DIE
S GMRAPA(0)=$G(^GMR(120.8,+GMRAPA,0))
S GMRAEN=GMRAPA_";GMR(120.8," D INPTYPE^GMRAUTL(GMRAEN) G Q1:GMRAOUT
S DA=GMRAPA,DIE="^GMR(120.8,",DR="2" D ^DIE S:$D(Y) GMRAOUT=1 G Q1:GMRAOUT
S GMRAPA(0)=$G(^GMR(120.8,+GMRAPA,0))
D DRGCLS^GMRAPED1
I 'GMRAOUT F K Y D Q:GMRAOUT!('$D(Y))
.S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
.S DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction",DIE="^GMR(120.8,",DA=GMRAPA D ^DIE
.I $D(Y) S GMRAOUT=1 Q
.S GMRANEW(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
.I $P(GMRANEW(0),"^",6)="" W $C(7)," Required??" S Y="" Q
.Q:$P(GMRANEW(0),"^",6)=$P(GMRAPA(0),"^",6)
.I $P(GMRAPA(0),"^",6)'=$P(GMRANEW(0),"^",6) D Q
..W !!,"You cannot change the type of reaction. If this is incorrect",!,"please exit and mark this entry as entered-in-error and then re-enter",!,"the correct information.",!
..S DIE="^GMR(120.8,",DR="6////"_$P(GMRAPA(0),"^",6),DA=GMRAPA D ^DIE S Y="" Q
..Q
.Q
I 'GMRAOUT D EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT)
I 'GMRAOUT D MECH Q:GMRAOUT
S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
S GMRAOUT=0 G EN1
Q1 ;Exit
K GMRAEN,X,GMRAAR,^TMP($J,"GMRAING"),^TMP($J,"GMRADCL") ;41 Added ^TMP
K DA,DIE,DR
Q
MECH ;Mechanism for ADRs
F W !!,?5,"Choose one of the following:",! D Q:GMRAOUT!('$D(Y))
.F GMRAMEC="A - ALLERGY","P - PHARMACOLOGICAL","U - UNKNOWN" W !,?20,GMRAMEC
.W ! S DIE="^GMR(120.8,",DA=GMRAPA,DR=17 D ^DIE
.S:$D(Y) GMRAOUT=1
.Q
Q
HELP ; HELP FOR A/AR LOOKUP
D HELP^GMRAPED0 ;41 removed duplicate code and added call to HELP
Q
DIC ; VALIDATE LOOKUP FOR A/AR
S:$D(DTOUT) X="^^" I X="^^" S GMRAOUT=1 Q
S:$D(DUOUT) Y=0 Q:+Y'>0
YNOK W !?3,X," OK" S %=1 D YN^DICN S:%=-1 GMRAOUT=1,Y=-1 S:%=2 Y=-1 I % W ! Q
W !?5,$C(7),"ANSWER YES IF THIS IS THE CORRECT ALLERGY/ADVERSE REACTION,",!?5,"ELSE ANSWER NO."
G YNOK
HEAD ; Header for reactions
W @IOF
W !,"Reactions: (cont.) "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPED0 4245 printed Jan 18, 2025@02:41:04 Page 2
GMRAPED0 ;HIRMFO/RM,WAA-VERIFIER EDIT OF DRUG A/AR ;11/16/07 10:03
+1 ;;4.0;Adverse Reaction Tracking;**17,41**;Mar 29, 1996;Build 8
+2 ;DBIA Section
+3 ;PSN50P41 - 4531
+4 ;PSN50P65 - 4543
+5 ;DICN - 10009
+6 ;DIE - 10018
+7 ;XLFDT - 10103
EN1 ; ENTRY TO EDIT INFO SPECIFIC TO DRUG A/AR FOR VERIFIER
+1 ;41 Add ^TMP to list
KILL GMRAINGR,GMRACLAS,^TMP($JOB,"GMRAING"),^TMP($JOB,"GMRADCL")
+2 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
GOTO Q1
+3 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
GOTO Q1
+4 ;41 Added block structure
FOR GMRAINGR=0:0
SET GMRAINGR=$ORDER(^GMR(120.8,GMRAPA,2,GMRAINGR))
if GMRAINGR'>0
QUIT
Begin DoDot:1
+5 ;41 added call to ZERO
SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,2,GMRAINGR,0)):^(0),1:"")
IF +X>0
DO ZERO^PSN50P41(+X,,$$DT^XLFDT,"GMRAING")
SET Y=$SELECT($DATA(^TMP($JOB,"GMRAING",+X,.01)):^(.01),1:"")
IF $PIECE(Y,U)'=""
SET GMRAINGR($PIECE(Y,U),+X)=Y
End DoDot:1
+6 ;41 Added dot structure
FOR GMRACLAS=0:0
SET GMRACLAS=$ORDER(^GMR(120.8,GMRAPA,3,GMRACLAS))
if GMRACLAS'>0
QUIT
Begin DoDot:1
+7 ;41 Added call to C^PSN50P65
SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,3,GMRACLAS,0)):^(0),1:"")
IF +X>0
DO C^PSN50P65(+X,,"GMRADCL")
SET Y=$SELECT($DATA(^TMP($JOB,"GMRADCL",+X,.01)):^(.01)_U_$GET(^(1)),1:"")
IF $PIECE(Y,U)'=""
SET GMRACLAS($PIECE(Y,U),+X)=Y
End DoDot:1
+8 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
+9 WRITE @IOF
+10 WRITE !,"CAUSATIVE AGENT: ",$PIECE(GMRAPA(0),U,2)
+11 WRITE !?11,"TYPE: ",$$OUTTYPE^GMRAUTL($PIECE(GMRAPA(0),U,20))
+12 WRITE !?4,"INGREDIENTS: "
SET Y=""
SET GMRAPRSW=0
FOR
SET Y=$ORDER(GMRAINGR(Y))
if Y=""
QUIT
FOR X=0:0
SET X=$ORDER(GMRAINGR(Y,X))
if X'>0
QUIT
if GMRAPRSW
WRITE !
WRITE ?17,Y
if 'GMRAPRSW
SET GMRAPRSW=1
+13 WRITE !,"VA DRUG CLASSES: "
+14 SET Y=""
SET GMRAPRSW=0
FOR
SET Y=$ORDER(GMRACLAS(Y))
if Y=""
QUIT
FOR X=0:0
SET X=$ORDER(GMRACLAS(Y,X))
if X'>0
QUIT
if GMRAPRSW
WRITE !
WRITE ?17,Y," - ",$PIECE(GMRACLAS(Y,X),U,2)
if 'GMRAPRSW
SET GMRAPRSW=1
+15 WRITE !," OBS/HIST: ",$SELECT($PIECE(GMRAPA(0),U,6)="o":"OBSERVED",$PIECE(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")
+16 ;Sign/Symptoms
Begin DoDot:1
+17 NEW GMRAVFY
+18 SET GMRAVFY=1
+19 DO EN1^GMRADSP3
+20 QUIT
End DoDot:1
+21 WRITE !," MECHANISM: ",$SELECT($PIECE(GMRAPA(0),U,14)="A":"ALLERGY",$PIECE(GMRAPA(0),U,14)="P":"PHARMACOLOGIC",$PIECE(GMRAPA(0),U,14)="U":"UNKNOWN",1:"")
YNED WRITE !!,"Would you like to edit any of this data"
SET %=0
DO YN^DICN
IF '%
WRITE !?4,$CHAR(7),"ANSWER YES IF YOU WISH TO CHANGE ANY OF THE DATA ABOVE, ELSE ANSWER NO."
GOTO YNED
+1 if %=-1
SET GMRAOUT=1
if %=2!GMRAOUT
GOTO Q1
+2 DO EN1^GMRAPED3
if GMRAOUT
GOTO Q1
IF GMRAAR'=""
SET DIE="^GMR(120.8,"
SET DA=GMRAPA
SET DR=".02////^S X=GMRAAR(0);1////^S X=GMRAAR"_$SELECT($DATA(GMRAAR("O")):";3.1////"_GMRAAR("O"),1:"")
DO ^DIE
+3 SET GMRAPA(0)=$GET(^GMR(120.8,+GMRAPA,0))
+4 SET GMRAEN=GMRAPA_";GMR(120.8,"
DO INPTYPE^GMRAUTL(GMRAEN)
if GMRAOUT
GOTO Q1
+5 SET DA=GMRAPA
SET DIE="^GMR(120.8,"
SET DR="2"
DO ^DIE
if $DATA(Y)
SET GMRAOUT=1
if GMRAOUT
GOTO Q1
+6 SET GMRAPA(0)=$GET(^GMR(120.8,+GMRAPA,0))
+7 DO DRGCLS^GMRAPED1
+8 IF 'GMRAOUT
FOR
KILL Y
Begin DoDot:1
+9 SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
+10 SET DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction"
SET DIE="^GMR(120.8,"
SET DA=GMRAPA
DO ^DIE
+11 IF $DATA(Y)
SET GMRAOUT=1
QUIT
+12 SET GMRANEW(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
+13 IF $PIECE(GMRANEW(0),"^",6)=""
WRITE $CHAR(7)," Required??"
SET Y=""
QUIT
+14 if $PIECE(GMRANEW(0),"^",6)=$PIECE(GMRAPA(0),"^",6)
QUIT
+15 IF $PIECE(GMRAPA(0),"^",6)'=$PIECE(GMRANEW(0),"^",6)
Begin DoDot:2
+16 WRITE !!,"You cannot change the type of reaction. If this is incorrect",!,"please exit and mark this entry as entered-in-error and then re-enter",!,"the correct information.",!
+17 SET DIE="^GMR(120.8,"
SET DR="6////"_$PIECE(GMRAPA(0),"^",6)
SET DA=GMRAPA
DO ^DIE
SET Y=""
QUIT
+18 QUIT
End DoDot:2
QUIT
+19 QUIT
End DoDot:1
if GMRAOUT!('$DATA(Y))
QUIT
+20 IF 'GMRAOUT
DO EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT)
+21 IF 'GMRAOUT
DO MECH
if GMRAOUT
QUIT
+22 SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
+23 SET GMRAOUT=0
GOTO EN1
Q1 ;Exit
+1 ;41 Added ^TMP
KILL GMRAEN,X,GMRAAR,^TMP($JOB,"GMRAING"),^TMP($JOB,"GMRADCL")
+2 KILL DA,DIE,DR
+3 QUIT
MECH ;Mechanism for ADRs
+1 FOR
WRITE !!,?5,"Choose one of the following:",!
Begin DoDot:1
+2 FOR GMRAMEC="A - ALLERGY","P - PHARMACOLOGICAL","U - UNKNOWN"
WRITE !,?20,GMRAMEC
+3 WRITE !
SET DIE="^GMR(120.8,"
SET DA=GMRAPA
SET DR=17
DO ^DIE
+4 if $DATA(Y)
SET GMRAOUT=1
+5 QUIT
End DoDot:1
if GMRAOUT!('$DATA(Y))
QUIT
+6 QUIT
HELP ; HELP FOR A/AR LOOKUP
+1 ;41 removed duplicate code and added call to HELP
DO HELP^GMRAPED0
+2 QUIT
DIC ; VALIDATE LOOKUP FOR A/AR
+1 if $DATA(DTOUT)
SET X="^^"
IF X="^^"
SET GMRAOUT=1
QUIT
+2 if $DATA(DUOUT)
SET Y=0
if +Y'>0
QUIT
YNOK WRITE !?3,X," OK"
SET %=1
DO YN^DICN
if %=-1
SET GMRAOUT=1
SET Y=-1
if %=2
SET Y=-1
IF %
WRITE !
QUIT
+1 WRITE !?5,$CHAR(7),"ANSWER YES IF THIS IS THE CORRECT ALLERGY/ADVERSE REACTION,",!?5,"ELSE ANSWER NO."
+2 GOTO YNOK
HEAD ; Header for reactions
+1 WRITE @IOF
+2 WRITE !,"Reactions: (cont.) "
+3 QUIT
