- GMRAPED0 ;HIRMFO/RM,WAA-VERIFIER EDIT OF DRUG A/AR ;01-May-2012 14:23;DU
- ;;4.0;Adverse Reaction Tracking;**17,1002,1006**;Mar 29, 1996;Build 29
- EN1 ; ENTRY TO EDIT INFO SPECIFIC TO DRUG A/AR FOR VERIFIER
- ;IHS/MSC/MGH added data to edit source Patch 1006
- K GMRAINGR,GMRACLAS
- 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 S X=$S($D(^GMR(120.8,GMRAPA,2,GMRAINGR,0)):^(0),1:"") I +X>0 S Y=$S($D(^PS(50.416,+X,0)):^(0),1:"") I $P(Y,U)'="" S GMRAINGR($P(Y,U),+X)=Y
- F GMRACLAS=0:0 S GMRACLAS=$O(^GMR(120.8,GMRAPA,3,GMRACLAS)) Q:GMRACLAS'>0 S X=$S($D(^GMR(120.8,GMRAPA,3,GMRACLAS,0)):^(0),1:"") I +X>0 S Y=$S($D(^PS(50.605,+X,0)):^(0),1:"") I $P(Y,U)'="" S GMRACLAS($P(Y,U),+X)=Y
- 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
- ;IHS/MSC/MGH added to edit source Patch 1006
- S DA=GMRAPA,DIE="^GMR(120.8,",DR="9999999.11" D ^DIE S:$D(Y) GMRAOUT=1 G Q1:GMRAOUT
- 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)
- ;Add the SNOMED event type IHS/MSC/MGH Patch 1006
- I 'GMRAOUT D EVENT Q: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
- K DA,DIE,DR,DIC
- 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
- EVENT ;Store the event
- N DIC,DA,DR,DIE,X,Y,IEN,TXT,MECH
- S TXT=""
- S DIE="^GMR(120.8,",DA=GMRAPA,DR=9999999.13
- D ^DIE
- I X'="" S TXT=$P($G(^BEHOAR(90460.06,X,0)),U,1)
- ;Add the mechanism in here
- S MECH=$S(TXT="DRUG ALLERGY":"A",TXT="FOOD ALLERGY":"A",TXT="DRUG INTOLERANCE":"P",1:"U")
- S DIE="^GMR(120.8,",DA=GMRAPA,DR="17///^S X=MECH" D ^DIE
- S:$D(Y) GMRAOUT=1
- Q
- HELP ; HELP FOR A/AR LOOKUP
- W !!?4,"Would you like to see a list of:",!?6,"1 Local Allergies (Food/Drug/Other)",!?6,"2 Drug Classes",!?6,"3 Drug Ingredients",!?6,"4 National Drugs",!?6,"5 Local Drugs"
- R !?4,"Select a number (1-5):",X:DTIME S:'$T X="^^" I "^^"[X S:X="^^"!(X=U) GMRAOUT=1 Q
- I X\1'=X!(X<1)!(X>5) W !?7,$C(7),"ANSWER WITH THE NUMBER (1-5) OF THE SELECTION FOR",!?7,"WHICH YOU WISH TO SEE MORE HELP." G HELP
- S DIC=$S(X=1:120.82,X=2:50.605,X=3:50.416,X=4:50.6,1:50) D HLPLK
- G HELP
- HLPLK ; LOOKUP ON FILE IN DIC
- S DIC(0)="E",X="??" S:DIC=50.416 D="P" S:DIC=50.605 DIC("W")="W ?10,$P(^(0),U,2)",DIC(0)="SE",D="C" D ^DIC:DIC'=50.605&(DIC'=50.416),IX^DIC:DIC=50.605!(DIC=50.416)
- 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
- GMRAPED0 ;HIRMFO/RM,WAA-VERIFIER EDIT OF DRUG A/AR ;01-May-2012 14:23;DU
- +1 ;;4.0;Adverse Reaction Tracking;**17,1002,1006**;Mar 29, 1996;Build 29
- EN1 ; ENTRY TO EDIT INFO SPECIFIC TO DRUG A/AR FOR VERIFIER
- +1 ;IHS/MSC/MGH added data to edit source Patch 1006
- +2 KILL GMRAINGR,GMRACLAS
- +3 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- GOTO Q1
- +4 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- IF GMRAPA(0)=""
- GOTO Q1
- +5 FOR GMRAINGR=0:0
- SET GMRAINGR=$ORDER(^GMR(120.8,GMRAPA,2,GMRAINGR))
- IF GMRAINGR'>0
- QUIT
- SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,2,GMRAINGR,0)):^(0),1:"")
- IF +X>0
- SET Y=$SELECT($DATA(^PS(50.416,+X,0)):^(0),1:"")
- IF $PIECE(Y,U)'=""
- SET GMRAINGR($PIECE(Y,U),+X)=Y
- +6 FOR GMRACLAS=0:0
- SET GMRACLAS=$ORDER(^GMR(120.8,GMRAPA,3,GMRACLAS))
- IF GMRACLAS'>0
- QUIT
- SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,3,GMRACLAS,0)):^(0),1:"")
- IF +X>0
- SET Y=$SELECT($DATA(^PS(50.605,+X,0)):^(0),1:"")
- IF $PIECE(Y,U)'=""
- SET GMRACLAS($PIECE(Y,U),+X)=Y
- +7 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- +8 WRITE @IOF
- +9 WRITE !,"CAUSATIVE AGENT: ",$PIECE(GMRAPA(0),U,2)
- +10 WRITE !?11,"TYPE: ",$$OUTTYPE^GMRAUTL($PIECE(GMRAPA(0),U,20))
- +11 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
- +12 WRITE !,"VA DRUG CLASSES: "
- +13 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
- +14 WRITE !," OBS/HIST: ",$SELECT($PIECE(GMRAPA(0),U,6)="o":"OBSERVED",$PIECE(GMRAPA(0),U,6)="h":"HISTORICAL",1:"")
- +15 ;Sign/Symptoms
- Begin DoDot:1
- +16 NEW GMRAVFY
- +17 SET GMRAVFY=1
- +18 DO EN1^GMRADSP3
- +19 QUIT
- End DoDot:1
- +20 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 ;IHS/MSC/MGH added to edit source Patch 1006
- +9 SET DA=GMRAPA
- SET DIE="^GMR(120.8,"
- SET DR="9999999.11"
- DO ^DIE
- IF $DATA(Y)
- SET GMRAOUT=1
- IF GMRAOUT
- GOTO Q1
- +10 IF 'GMRAOUT
- FOR
- KILL Y
- Begin DoDot:1
- +11 SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
- +12 SET DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction"
- SET DIE="^GMR(120.8,"
- SET DA=GMRAPA
- DO ^DIE
- +13 IF $DATA(Y)
- SET GMRAOUT=1
- QUIT
- +14 SET GMRANEW(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
- +15 IF $PIECE(GMRANEW(0),"^",6)=""
- WRITE $CHAR(7)," Required??"
- SET Y=""
- QUIT
- +16 IF $PIECE(GMRANEW(0),"^",6)=$PIECE(GMRAPA(0),"^",6)
- QUIT
- +17 IF $PIECE(GMRAPA(0),"^",6)'=$PIECE(GMRANEW(0),"^",6)
- Begin DoDot:2
- +18 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.",!
- +19 SET DIE="^GMR(120.8,"
- SET DR="6////"_$PIECE(GMRAPA(0),"^",6)
- SET DA=GMRAPA
- DO ^DIE
- SET Y=""
- QUIT
- +20 QUIT
- End DoDot:2
- QUIT
- +21 QUIT
- End DoDot:1
- IF GMRAOUT!('$DATA(Y))
- QUIT
- +22 IF 'GMRAOUT
- DO EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT)
- +23 ;Add the SNOMED event type IHS/MSC/MGH Patch 1006
- +24 IF 'GMRAOUT
- DO EVENT
- IF GMRAOUT
- QUIT
- +25 ;I 'GMRAOUT D MECH Q:GMRAOUT
- +26 SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
- +27 SET GMRAOUT=0
- GOTO EN1
- Q1 ;Exit
- +1 KILL GMRAEN,X,GMRAAR
- +2 KILL DA,DIE,DR,DIC
- +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
- EVENT ;Store the event
- +1 NEW DIC,DA,DR,DIE,X,Y,IEN,TXT,MECH
- +2 SET TXT=""
- +3 SET DIE="^GMR(120.8,"
- SET DA=GMRAPA
- SET DR=9999999.13
- +4 DO ^DIE
- +5 IF X'=""
- SET TXT=$PIECE($GET(^BEHOAR(90460.06,X,0)),U,1)
- +6 ;Add the mechanism in here
- +7 SET MECH=$SELECT(TXT="DRUG ALLERGY":"A",TXT="FOOD ALLERGY":"A",TXT="DRUG INTOLERANCE":"P",1:"U")
- +8 SET DIE="^GMR(120.8,"
- SET DA=GMRAPA
- SET DR="17///^S X=MECH"
- DO ^DIE
- +9 IF $DATA(Y)
- SET GMRAOUT=1
- +10 QUIT
- HELP ; HELP FOR A/AR LOOKUP
- +1 WRITE !!?4,"Would you like to see a list of:",!?6,"1 Local Allergies (Food/Drug/Other)",!?6,"2 Drug Classes",!?6,"3 Drug Ingredients",!?6,"4 National Drugs",!?6,"5 Local Drugs"
- +2 READ !?4,"Select a number (1-5):",X:DTIME
- IF '$TEST
- SET X="^^"
- IF "^^"[X
- IF X="^^"!(X=U)
- SET GMRAOUT=1
- QUIT
- +3 IF X\1'=X!(X<1)!(X>5)
- WRITE !?7,$CHAR(7),"ANSWER WITH THE NUMBER (1-5) OF THE SELECTION FOR",!?7,"WHICH YOU WISH TO SEE MORE HELP."
- GOTO HELP
- +4 SET DIC=$SELECT(X=1:120.82,X=2:50.605,X=3:50.416,X=4:50.6,1:50)
- DO HLPLK
- +5 GOTO HELP
- HLPLK ; LOOKUP ON FILE IN DIC
- +1 SET DIC(0)="E"
- SET X="??"
- IF DIC=50.416
- SET D="P"
- IF DIC=50.605
- SET DIC("W")="W ?10,$P(^(0),U,2)"
- SET DIC(0)="SE"
- SET D="C"
- IF DIC'=50.605&(DIC'=50.416)
- DO ^DIC
- IF DIC=50.605!(DIC=50.416)
- DO IX^DIC
- +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
