- GMRAPEM0 ; HIRMFO/WAA,FT - ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER; October 18, 2023@08:47:00
- ;;4.0;Adverse Reaction Tracking;**2,5,17,21,36,50,58,63,51,68**;Mar 29, 1996;Build 5
- ;
- ; Reference to $$ONOFF^ORB3USER in ICR #7211
- ; Reference to CHKMEDS^ORWDAL32,GETPROV^ORWDAL32,SENDALRT^ORWDAL32 in ICR #6756
- ;
- EN11 ; Entry point for GMRA USER E/E PAT REC DATA option
- ; GMRAUSER is a flag that indicates that this is a User
- ; If user has Verifier Key then user will act normal
- I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
- ;
- EN1 ; Entry for ENTER/EDIT PATIENT REACTION DATA option
- ; EDIT PATIENT A/AR (DFN UNK.)
- S GMRAOUT=0
- W @IOF D PAT^GMRAPAT ; Select A Patient
- D:'GMRAOUT EN21 G:'GMRAOUT EN1
- K DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER
- D EXIT,EN1^GMRAKILL
- Q
- ;
- EN21 ; Process patient data and determine if patient is NKA
- S GMRAOUT=$G(GMRAOUT,0)
- ; check patient assessment before enter/edit reaction
- I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
- .N DA,DIK
- .S DIK="^GMR(120.86,",DA=DFN D ^DIK
- .Q
- I '$$NKA^GMRANKA(DFN) D NKAASK^GMRANKA(DFN,.GMRAOUT) Q:GMRAOUT I '$$NKA^GMRANKA(DFN) Q
- L +^XTMP("GMRAED",DFN):1 I '$T D MESS^GMRAGUI1 Q ;21
- S GMRAOUT=0
- D:'GMRAOUT SELECT
- I $G(GMRAPA)'>0 S GMRAOUT=0
- S GMRARP=1 I 'GMRAOUT D
- .D ASK^GMRAUTL("Enter another Causative Agent? ",.GMRAOUT,.GMRARP)
- .I 'GMRARP S GMRACNT=$O(^TMP($J,"GMRASF","B"),-1) D
- ..I GMRACNT D SIGNOFF^GMRASIGN
- ..I 'GMRAOUT D IDBAND^GMRASIGN
- ..I GMRAOUT S GMRAOUT=2-GMRAOUT D:GMRAOUT&($D(^TMP($J,"GMRASF"))) ALERT^GMRASIGN K ^TMP($J,"GMRASF"),GMRACNT
- ..Q
- .Q
- I GMRARP,'GMRAOUT K GMRARP L -^XTMP("GMRAED",DFN) G EN21 ;21
- K GMRARP
- ; check patient assessment when exiting enter/edit reaction
- I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
- .N DA,DIK
- .S DIK="^GMR(120.86,",DA=DFN D ^DIK
- .Q
- L -^XTMP("GMRAED",DFN) ;21
- Q
- ;
- EN2 ; EDIT PATIENT A/AR (DFN KNOWN)
- ; Called from the GMRAOR ALLERGY ENTER/EDIT protocol
- I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
- N GMRAOUT
- D EN21 D
- .;N GMRAOUT
- .D EXIT,EN1^GMRAKILL
- .Q
- K GMA,GMRARET,GMRAUSER
- Q
- ;
- ALERT ; PROCESS ALERTS FOR ART
- N DFN,GMRAPA,GMRACNT,GMRAOUT,GMRANEW,GMRAUSER
- S (GMRACNT,GMRAOUT,GMRANEW)=0 D
- . I $G(XQADATA)="" S XQAKILL=0 Q
- . S DFN=$P(XQADATA,U),GMRAPA=$P(XQADATA,U,2),GMRAUSER=$P(XQADATA,U,3) Q:'DFN!'GMRAPA
- . I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) K GMRAUSER
- . S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
- . I $P(GMRAPA(0),U,12) D Q
- . . W !,"This reaction has been signed off.",$C(7)
- . . D HANGT^GMRAPEH0
- . . S XQAKILL=0
- . . Q
- . D EDIT^GMRAPEM4
- . D UPDATE^GMRAPEM3
- . I '$P(GMRAPA(0),U,12) D SIGNOFF^GMRASIGN
- . I GMRAOUT S GMRAOUT=2-GMRAOUT K XQAKILL
- . E D
- . .I $P(GMRAPA(0),U,12) S XQAKILL=0
- . .I '$P(GMRAPA(0),U,12) K XQAKILL
- . D EXIT,EN1^GMRAKILL
- . Q
- Q
- ;
- SELECT ;Select a patient reaction
- S GMRACNT=0 D 1^VADPT
- S GMRALOC=$P(VAIN(4),U,2),GMRANAM=VADM(1),GMRASEX=VADM(5),GMRAOUT=0,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0)) D KVAR^VADPT K VA,VAROOT
- K GMRADUP S GMRALAGO=1
- D REACT^GMRAPAT(DFN) ; Load all reaction for this patient.
- D EN1^GMRAPES0
- I GMRAPA>0 D TYPE D
- .I $G(GMRAEVT) D XQOR ;post event if anything edited ;P68
- .I GMRAOUT D:$G(GMRANEW) DELETE S:'$$MISSREQ&('$P($G(GMRAPA(0)),U,12)) GMRAOUT=0,^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)="",^TMP($J,"GMRASF",GMRACNT,GMRAPA)="" D:GMRAOUT UPOUT^GMRAPEM3 Q ; 21,36
- .I GMRAERR D ERR^GMRAPEM3 Q ;The reaction was entered in error
- .I $P(GMRAPA(0),U,12) D SIGNED^GMRAPEM3 Q ;The reaction has been signed
- .; Reaction is a new reaction or Update data
- .I GMRANEW D GMRACHK^GMRAPEM0(GMRAPA)
- .I GMRANEW D MEDCHK ; NSR 20070203
- .D UPDATE^GMRAPEM3
- .Q
- K GMRAEVT
- Q
- ;
- TYPE ; Select the type of the process to use this reaction
- S GMRAERR=0,GMRAEVT=0 K GMRAPA1
- ; If reaction is not new check to see if user want to enter in error
- I 'GMRANEW W @IOF N GMRADFN D EN1^GMRAPEE0 I GMRAERR!GMRAOUT Q
- ;If reaction is observed and signed off
- I $P(GMRAPA(0),U,6)="o",$P(GMRAPA(0),U,12) D Q:GMRAOUT
- .Q:$G(GMRAUSER,0)
- .N GMRARP
- .S GMRARP=0 D ASK^GMRAUTL("DO YOU WISH TO EDIT OBSERVED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
- .Q:'GMRARP ;Observed data
- .N GMRAOD S GMRAOD=$D(^GMR(120.85,"C",GMRAPA)) ;Existing observation data?
- OBSDATE .;
- .S GMRALAGO=1 F D EN2^GMRAU85 Q:GMRAPA1>0 Q:GMRAOUT W !,"You must enter a valid date or an Up-arrow to exit",!,$C(7)
- .I 'GMRAOUT,GMRAPA1>0 D EN2^GMRAROBS S:$P($G(^GMR(120.8,GMRAPA,0)),U,16)=1 GMRAEVT=1 ;P68
- .I '$D(^GMR(120.85,"C",GMRAPA)),$G(GMRANEW)!('$G(GMRANEW)&($G(GMRAOD))) D OBSPROB S GMRAOUT=0 G OBSDATE
- .Q
- ;Verify data
- I 'GMRAERR,$P($G(^GMR(120.8,GMRAPA,0)),U,16)=0,$P(GMRAPA(0),U,12)=1,$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q:GMRAOUT
- .K GMRAVER S GMRAVER=0
- .N GMRAPRNT D EN1^GMRAVFY K GMRALLER,GMRAMEC,GMRAY
- .I $P($G(^GMR(120.8,GMRAPA,0)),U,16)=1 S GMRASLL(GMRAPA)=1
- .Q
- ;EDIT Verified data
- I 'GMRAERR,$P($G(^GMR(120.8,GMRAPA,0)),U,16)=1,$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q:GMRAOUT
- .Q:$G(GMRAVER)=1
- .N GMRARP
- .S GMRARP=0
- .D ASK^GMRAUTL("DO YOU WISH TO EDIT VERIFIED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
- .I GMRARP D SITE^GMRAUTL,EN1^GMRAPED0 S GMRAEVT=1 ;P68
- .Q
- ;if the reaction is new or not signed off
- I '$P(GMRAPA(0),U,12) D
- .D EDIT^GMRAPEM4
- .I $P($G(^GMR(120.8,GMRAPA,0)),U,16) S GMRASLL(GMRAPA)=1
- .Q
- Q
- ;
- EXIT S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRASF","B",GMRAPA)) Q:GMRAPA<1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
- K ^TMP($J,"GMRASF")
- K ^TMP($J,"GMRALST")
- Q
- ;
- DELETE ;Delete entry if required information is not entered - section added in 17
- N DA,DIK,GMRAPA1
- W !!,"Entry process not completed, deleting entry...",!
- S GMRAPA1=$O(^GMR(120.85,"C",GMRAPA,0))
- I GMRAPA1,$G(^GMR(120.85,GMRAPA1,0))="" K ^GMR(120.85,"C",GMRAPA,GMRAPA1)
- I GMRAPA1 S DIK="^GMR(120.85,",DA=GMRAPA1 D ^DIK D UNLOCK^GMRAUTL(120.85,GMRAPA1)
- I GMRAPA S DIK="^GMR(120.8,",DA=GMRAPA D ^DIK D UNLOCK^GMRAUTL(120.8,GMRAPA)
- Q
- ;
- OBSPROB ;Display help information for missing observed date/time entry
- W !!,"Observed reactions must have at least one observation entry.",!,"If this reaction is incorrect then enter a date and then proceed",!,"to mark it as entered in error.",!
- Q
- ;
- MISSREQ() ;Function determines if required data is missing
- N GMRA0,TYPE
- S GMRA0=$G(^GMR(120.8,+$G(GMRAPA),0)) I GMRA0="" Q 1 ;Entry not found
- S TYPE=$P(GMRA0,U,6) ;Get observed/historical
- I TYPE="" Q 1 ;Type not entered
- I TYPE="h" Q 0 ;Historical has no requirements
- I TYPE="o" I '$D(^GMR(120.85,"C",GMRAPA))!('$O(^GMR(120.85,+$O(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM) Q 1 ;Missing obs date/time or sign/symptom or required comment
- Q 0
- ;
- REQCOM() ;Function determines if comments required
- I '$D(GMRASITE) D SITE^GMRAUTL
- I +$P(^GMRD(120.84,+GMRASITE,0),U,4)=0 Q 1 ;Comments required?
- I $O(^GMR(120.8,GMRAPA,26,0)) Q 1
- Q 0
- ;
- GMRACHK(GMRAPA) ;
- ;Send a warning MailMan message if the VA DRUG CLASS field is empty.
- ;Get the first, if any,VA DRUG CLASS entries for this agent.
- N PATALLER,VADRCL1,PATNAME,REAC,REACTS,LINE
- N PATIEN,SSN,LAST4
- D GETS^DIQ(120.8,GMRAPA_",","**","E","PATALLER")
- ;mod by CAS - to skip all but "D" Drug type reactions
- I $P($G(^GMR(120.8,GMRAPA,0)),"^",20)'["D" Q
- S VADRCL1=$G(PATALLER(120.803,"1,"_GMRAPA_",",.01,"E"))
- S PATNAME=$G(PATALLER(120.8,GMRAPA_",",.01,"E"))
- S PATIEN=$$GET1^DIQ(120.8,GMRAPA,.01,"I")
- S SSN=$$GET1^DIQ(2,PATIEN,.09,"E")
- S LAST4=$E(PATNAME,1,1)_$E(SSN,6,9)
- I '$G(GMRAERR),(VADRCL1=""),(PATNAME'="") D
- . K ^XTMP("GMRACHK",$J)
- . S LINE=1
- . S ^XTMP("GMRACHK",$J,LINE)="The following allergy/adverse reaction may need a VA DRUG CLASS added"
- . S LINE=LINE+1
- . S ^XTMP("GMRACHK",$J,LINE)="for the following Patient:"
- . S LINE=LINE+1
- . S ^XTMP("GMRACHK",$J,LINE)=""
- . S LINE=LINE+1
- . S ^XTMP("GMRACHK",$J,LINE)="Patient: "_PATNAME
- . S LINE=LINE+1
- . S ^XTMP("GMRACHK",$J,LINE)="LAST4: "_LAST4
- . S LINE=LINE+1
- . S ^XTMP("GMRACHK",$J,LINE)="Reactant: "_$G(PATALLER(120.8,GMRAPA_",",.02,"E"))
- . S LINE=LINE+1
- . ;Build a pretty string of reactions
- . S REAC=1
- . S REACTS=$G(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
- . S REAC=REAC+1
- . F Q:'$D(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E")) D
- . . S REACTS=REACTS_", "_$G(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
- . . S REAC=REAC+1
- . S ^XTMP("GMRACHK",$J,LINE)="Reactions: "_REACTS
- . S LINE=LINE+1
- . S ^XTMP("GMRACHK",$J,LINE)="OBS/HIS: "_$G(PATALLER(120.8,GMRAPA_",",6,"E"))
- . S LINE=LINE+1
- . S ^XTMP("GMRACHK",$J,LINE)="Location: "_$$GET1^DIQ(405,$$GET1^DIQ(2,DFN,.102,"I"),.06,"E")
- . S LINE=LINE+1
- . S XMDUZ=DUZ
- . S XMTEXT="^XTMP(""GMRACHK"","_$J_","
- . I $G(DUZ(2))="" S DUZ(2)=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
- . S XMSUB="ALLERGY/ADVERSE REACTION WITHOUT VA DRUG CLASS ("
- . S XMSUB=XMSUB_$P($$NS^XUAF4(DUZ(2)),U)_")"
- . S XMY("G.ADVERSE_ALLERGY_WARNING")=""
- . D ^XMD
- . K ^XTMP("GMRACHK",$J)
- Q
- ;
- MEDCHK ; NSR 20070203
- N GMRAMCHK
- W !!,?2,"Checking new allergy against the patient's active medication profile . . . "
- D CHKMEDS^ORWDAL32(.GMRAMCHK,$P(GMRAPA(0),"^"),$P(GMRAPA(0),"^",2))
- I GMRAMCHK'>0 W !!,?2,"No conflicts were discovered.",! K GMRAMCHK Q
- I GMRAMCHK>0 D
- . N GMRADA,GMRAYN,GMRAPROV,GMRASEND,GMRASLST,GMRALST,GMRAORD,GMRADUZ,GMRAOUT
- . W !!,?2,"The following Active Orders contain "_$P(GMRAPA(0),"^",2)_":"
- . S GMRADA=""
- . F S GMRADA=$O(GMRAMCHK(GMRADA)) Q:GMRADA="" I $D(GMRAMCHK(GMRADA)) D
- . . W !!,$P(GMRAMCHK(GMRADA),"^",3)_" (Order #"_$P(GMRAMCHK(GMRADA),"^")_") An alert will be sent to:"
- . . D GETPROV^ORWDAL32(.GMRAPROV,$P(GMRAMCHK(GMRADA),"^"),+$G(DFN))
- . . N PRVDA S PRVDA=""
- . . F S PRVDA=$O(GMRAPROV(PRVDA)) Q:PRVDA="" I $D(GMRAPROV(PRVDA)) D
- . . . S GMRASLST($P(GMRAMCHK(GMRADA),"^"),$P(GMRAPROV(PRVDA),";"))=GMRAPROV(PRVDA)
- . . . W !?3,$P(GMRAPROV(PRVDA),"^",2)," - ",$P(GMRAPROV(PRVDA),"^",3)
- . . K GMRAPROV
- . W !!
- . S (GMRAOUT,GMRAYN)=0 D ASK^GMRAUTL("Do you wish to send the alert(s) to additional recipients? ",.GMRAOUT,.GMRAYN) Q:GMRAOUT
- . I GMRAYN D ADDSTHR(.GMRALST)
- . I $D(GMRASLST) S GMRAORD="" F S GMRAORD=$O(GMRASLST(GMRAORD)) Q:GMRAORD="" I $D(GMRASLST(GMRAORD)) D
- . . K GMRAPROV
- . . S GMRAPROV=""
- . . I $D(GMRALST) M GMRAPROV=GMRALST
- . . D SENDALRT^ORWDAL32(.GMRASEND,GMRAORD,.GMRAPROV)
- . K GMRASEND,GMRASLST
- K GMRAMCHK
- Q
- ;
- ADDSTHR(GMRALST) ; NSR 20070203
- K GMRALST
- N DIC,I,GMRAYN,GMRAON,GMRANOTE,GMRAOUT,Y
- S GMRAYN=0
- S GMRANOTE=88 ;NEW ALLERGY ENTERED/ACTIVE MED notification
- F I=1:1 D Q:'GMRAYN
- . S DIC="^VA(200,",DIC(0)="AEBQ"
- . S DIC("A")="Enter Recipient's Name: " D ^DIC
- . I +Y>0 D
- . . S GMRAON=$P($$ONOFF^ORB3USER(GMRANOTE,+Y,"","",""),U,1)
- . . I GMRAON="OFF" W !!," User is unable to receive the notification!",! Q
- . . S GMRALST($P(Y,"^"))=$P(Y,"^")_";VA(200,"_"^"_$P(Y,"^",2) K DIC,Y
- . S (GMRAOUT,GMRAYN)=0 D ASK^GMRAUTL("Add another recipient? ",.GMRAOUT,.GMRAYN) Q:GMRAOUT
- Q
- ;
- XQOR ; GMRA EDIT VERIFIED DATA event driver ;P68
- N X S X=+$O(^ORD(101,"B","GMRA EDIT VERIFIED DATA",0))_";ORD(101,"
- Q:'X Q:'$G(GMRAPA)
- S:'$D(GMRAPA(0)) GMRAPA(0)=$G(^GMR(120.8,+GMRAPA,0))
- I $D(GMRAPA1) D
- . S:$G(GMRAPA1)>0 GMRAPA1(0)=$G(^GMR(120.85,+GMRAPA1,0))
- . ; cleanup GMRAPA1 if no selection (carried over from last edit)
- . I $G(GMRAPA1)<0!($P(GMRAPA1(0),U,15)'=GMRAPA) K GMRAPA1
- D:X EN^XQOR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPEM0 11601 printed Jan 18, 2025@02:41:10 Page 2
- GMRAPEM0 ; HIRMFO/WAA,FT - ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER; October 18, 2023@08:47:00
- +1 ;;4.0;Adverse Reaction Tracking;**2,5,17,21,36,50,58,63,51,68**;Mar 29, 1996;Build 5
- +2 ;
- +3 ; Reference to $$ONOFF^ORB3USER in ICR #7211
- +4 ; Reference to CHKMEDS^ORWDAL32,GETPROV^ORWDAL32,SENDALRT^ORWDAL32 in ICR #6756
- +5 ;
- EN11 ; Entry point for GMRA USER E/E PAT REC DATA option
- +1 ; GMRAUSER is a flag that indicates that this is a User
- +2 ; If user has Verifier Key then user will act normal
- +3 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- SET GMRAUSER=1
- +4 ;
- EN1 ; Entry for ENTER/EDIT PATIENT REACTION DATA option
- +1 ; EDIT PATIENT A/AR (DFN UNK.)
- +2 SET GMRAOUT=0
- +3 ; Select A Patient
- WRITE @IOF
- DO PAT^GMRAPAT
- +4 if 'GMRAOUT
- DO EN21
- if 'GMRAOUT
- GOTO EN1
- +5 KILL DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER
- +6 DO EXIT
- DO EN1^GMRAKILL
- +7 QUIT
- +8 ;
- EN21 ; Process patient data and determine if patient is NKA
- +1 SET GMRAOUT=$GET(GMRAOUT,0)
- +2 ; check patient assessment before enter/edit reaction
- +3 ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
- IF $$NKA^GMRANKA(DFN)
- IF $$NKASCR^GMRANKA(DFN)
- Begin DoDot:1
- +4 NEW DA,DIK
- +5 SET DIK="^GMR(120.86,"
- SET DA=DFN
- DO ^DIK
- +6 QUIT
- End DoDot:1
- +7 IF '$$NKA^GMRANKA(DFN)
- DO NKAASK^GMRANKA(DFN,.GMRAOUT)
- if GMRAOUT
- QUIT
- IF '$$NKA^GMRANKA(DFN)
- QUIT
- +8 ;21
- LOCK +^XTMP("GMRAED",DFN):1
- IF '$TEST
- DO MESS^GMRAGUI1
- QUIT
- +9 SET GMRAOUT=0
- +10 if 'GMRAOUT
- DO SELECT
- +11 IF $GET(GMRAPA)'>0
- SET GMRAOUT=0
- +12 SET GMRARP=1
- IF 'GMRAOUT
- Begin DoDot:1
- +13 DO ASK^GMRAUTL("Enter another Causative Agent? ",.GMRAOUT,.GMRARP)
- +14 IF 'GMRARP
- SET GMRACNT=$ORDER(^TMP($JOB,"GMRASF","B"),-1)
- Begin DoDot:2
- +15 IF GMRACNT
- DO SIGNOFF^GMRASIGN
- +16 IF 'GMRAOUT
- DO IDBAND^GMRASIGN
- +17 IF GMRAOUT
- SET GMRAOUT=2-GMRAOUT
- if GMRAOUT&($DATA(^TMP($JOB,"GMRASF")))
- DO ALERT^GMRASIGN
- KILL ^TMP($JOB,"GMRASF"),GMRACNT
- +18 QUIT
- End DoDot:2
- +19 QUIT
- End DoDot:1
- +20 ;21
- IF GMRARP
- IF 'GMRAOUT
- KILL GMRARP
- LOCK -^XTMP("GMRAED",DFN)
- GOTO EN21
- +21 KILL GMRARP
- +22 ; check patient assessment when exiting enter/edit reaction
- +23 ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
- IF $$NKA^GMRANKA(DFN)
- IF $$NKASCR^GMRANKA(DFN)
- Begin DoDot:1
- +24 NEW DA,DIK
- +25 SET DIK="^GMR(120.86,"
- SET DA=DFN
- DO ^DIK
- +26 QUIT
- End DoDot:1
- +27 ;21
- LOCK -^XTMP("GMRAED",DFN)
- +28 QUIT
- +29 ;
- EN2 ; EDIT PATIENT A/AR (DFN KNOWN)
- +1 ; Called from the GMRAOR ALLERGY ENTER/EDIT protocol
- +2 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- SET GMRAUSER=1
- +3 NEW GMRAOUT
- +4 DO EN21
- Begin DoDot:1
- +5 ;N GMRAOUT
- +6 DO EXIT
- DO EN1^GMRAKILL
- +7 QUIT
- End DoDot:1
- +8 KILL GMA,GMRARET,GMRAUSER
- +9 QUIT
- +10 ;
- ALERT ; PROCESS ALERTS FOR ART
- +1 NEW DFN,GMRAPA,GMRACNT,GMRAOUT,GMRANEW,GMRAUSER
- +2 SET (GMRACNT,GMRAOUT,GMRANEW)=0
- Begin DoDot:1
- +3 IF $GET(XQADATA)=""
- SET XQAKILL=0
- QUIT
- +4 SET DFN=$PIECE(XQADATA,U)
- SET GMRAPA=$PIECE(XQADATA,U,2)
- SET GMRAUSER=$PIECE(XQADATA,U,3)
- if 'DFN!'GMRAPA
- QUIT
- +5 IF $DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- KILL GMRAUSER
- +6 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- if GMRAPA(0)=""
- QUIT
- +7 IF $PIECE(GMRAPA(0),U,12)
- Begin DoDot:2
- +8 WRITE !,"This reaction has been signed off.",$CHAR(7)
- +9 DO HANGT^GMRAPEH0
- +10 SET XQAKILL=0
- +11 QUIT
- End DoDot:2
- QUIT
- +12 DO EDIT^GMRAPEM4
- +13 DO UPDATE^GMRAPEM3
- +14 IF '$PIECE(GMRAPA(0),U,12)
- DO SIGNOFF^GMRASIGN
- +15 IF GMRAOUT
- SET GMRAOUT=2-GMRAOUT
- KILL XQAKILL
- +16 IF '$TEST
- Begin DoDot:2
- +17 IF $PIECE(GMRAPA(0),U,12)
- SET XQAKILL=0
- +18 IF '$PIECE(GMRAPA(0),U,12)
- KILL XQAKILL
- End DoDot:2
- +19 DO EXIT
- DO EN1^GMRAKILL
- +20 QUIT
- End DoDot:1
- +21 QUIT
- +22 ;
- SELECT ;Select a patient reaction
- +1 SET GMRACNT=0
- DO 1^VADPT
- +2 SET GMRALOC=$PIECE(VAIN(4),U,2)
- SET GMRANAM=VADM(1)
- SET GMRASEX=VADM(5)
- SET GMRAOUT=0
- SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
- DO KVAR^VADPT
- KILL VA,VAROOT
- +3 KILL GMRADUP
- SET GMRALAGO=1
- +4 ; Load all reaction for this patient.
- DO REACT^GMRAPAT(DFN)
- +5 DO EN1^GMRAPES0
- +6 IF GMRAPA>0
- DO TYPE
- Begin DoDot:1
- +7 ;post event if anything edited ;P68
- IF $GET(GMRAEVT)
- DO XQOR
- +8 ; 21,36
- IF GMRAOUT
- if $GET(GMRANEW)
- DO DELETE
- if '$$MISSREQ&('$PIECE($GET(GMRAPA(0)),U,12))
- SET GMRAOUT=0
- SET ^TMP($JOB,"GMRASF","B",GMRAPA,GMRACNT)=""
- SET ^TMP($JOB,"GMRASF",GMRACNT,GMRAPA)=""
- if GMRAOUT
- DO UPOUT^GMRAPEM3
- QUIT
- +9 ;The reaction was entered in error
- IF GMRAERR
- DO ERR^GMRAPEM3
- QUIT
- +10 ;The reaction has been signed
- IF $PIECE(GMRAPA(0),U,12)
- DO SIGNED^GMRAPEM3
- QUIT
- +11 ; Reaction is a new reaction or Update data
- +12 IF GMRANEW
- DO GMRACHK^GMRAPEM0(GMRAPA)
- +13 ; NSR 20070203
- IF GMRANEW
- DO MEDCHK
- +14 DO UPDATE^GMRAPEM3
- +15 QUIT
- End DoDot:1
- +16 KILL GMRAEVT
- +17 QUIT
- +18 ;
- TYPE ; Select the type of the process to use this reaction
- +1 SET GMRAERR=0
- SET GMRAEVT=0
- KILL GMRAPA1
- +2 ; If reaction is not new check to see if user want to enter in error
- +3 IF 'GMRANEW
- WRITE @IOF
- NEW GMRADFN
- DO EN1^GMRAPEE0
- IF GMRAERR!GMRAOUT
- QUIT
- +4 ;If reaction is observed and signed off
- +5 IF $PIECE(GMRAPA(0),U,6)="o"
- IF $PIECE(GMRAPA(0),U,12)
- Begin DoDot:1
- +6 if $GET(GMRAUSER,0)
- QUIT
- +7 NEW GMRARP
- +8 SET GMRARP=0
- DO ASK^GMRAUTL("DO YOU WISH TO EDIT OBSERVED DATA? ",.GMRAOUT,.GMRARP)
- if GMRAOUT
- QUIT
- +9 ;Observed data
- if 'GMRARP
- QUIT
- +10 ;Existing observation data?
- NEW GMRAOD
- SET GMRAOD=$DATA(^GMR(120.85,"C",GMRAPA))
- OBSDATE ;
- +1 SET GMRALAGO=1
- FOR
- DO EN2^GMRAU85
- if GMRAPA1>0
- QUIT
- if GMRAOUT
- QUIT
- WRITE !,"You must enter a valid date or an Up-arrow to exit",!,$CHAR(7)
- +2 ;P68
- IF 'GMRAOUT
- IF GMRAPA1>0
- DO EN2^GMRAROBS
- if $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)=1
- SET GMRAEVT=1
- +3 IF '$DATA(^GMR(120.85,"C",GMRAPA))
- IF $GET(GMRANEW)!('$GET(GMRANEW)&($GET(GMRAOD)))
- DO OBSPROB
- SET GMRAOUT=0
- GOTO OBSDATE
- +4 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +5 ;Verify data
- +6 IF 'GMRAERR
- IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)=0
- IF $PIECE(GMRAPA(0),U,12)=1
- IF $DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- Begin DoDot:1
- +7 KILL GMRAVER
- SET GMRAVER=0
- +8 NEW GMRAPRNT
- DO EN1^GMRAVFY
- KILL GMRALLER,GMRAMEC,GMRAY
- +9 IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)=1
- SET GMRASLL(GMRAPA)=1
- +10 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +11 ;EDIT Verified data
- +12 IF 'GMRAERR
- IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)=1
- IF $DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
- Begin DoDot:1
- +13 if $GET(GMRAVER)=1
- QUIT
- +14 NEW GMRARP
- +15 SET GMRARP=0
- +16 DO ASK^GMRAUTL("DO YOU WISH TO EDIT VERIFIED DATA? ",.GMRAOUT,.GMRARP)
- if GMRAOUT
- QUIT
- +17 ;P68
- IF GMRARP
- DO SITE^GMRAUTL
- DO EN1^GMRAPED0
- SET GMRAEVT=1
- +18 QUIT
- End DoDot:1
- if GMRAOUT
- QUIT
- +19 ;if the reaction is new or not signed off
- +20 IF '$PIECE(GMRAPA(0),U,12)
- Begin DoDot:1
- +21 DO EDIT^GMRAPEM4
- +22 IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),U,16)
- SET GMRASLL(GMRAPA)=1
- +23 QUIT
- End DoDot:1
- +24 QUIT
- +25 ;
- EXIT SET GMRAPA=0
- FOR
- SET GMRAPA=$ORDER(^TMP($JOB,"GMRASF","B",GMRAPA))
- if GMRAPA<1
- QUIT
- DO UNLOCK^GMRAUTL(120.8,GMRAPA)
- +1 KILL ^TMP($JOB,"GMRASF")
- +2 KILL ^TMP($JOB,"GMRALST")
- +3 QUIT
- +4 ;
- DELETE ;Delete entry if required information is not entered - section added in 17
- +1 NEW DA,DIK,GMRAPA1
- +2 WRITE !!,"Entry process not completed, deleting entry...",!
- +3 SET GMRAPA1=$ORDER(^GMR(120.85,"C",GMRAPA,0))
- +4 IF GMRAPA1
- IF $GET(^GMR(120.85,GMRAPA1,0))=""
- KILL ^GMR(120.85,"C",GMRAPA,GMRAPA1)
- +5 IF GMRAPA1
- SET DIK="^GMR(120.85,"
- SET DA=GMRAPA1
- DO ^DIK
- DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
- +6 IF GMRAPA
- SET DIK="^GMR(120.8,"
- SET DA=GMRAPA
- DO ^DIK
- DO UNLOCK^GMRAUTL(120.8,GMRAPA)
- +7 QUIT
- +8 ;
- OBSPROB ;Display help information for missing observed date/time entry
- +1 WRITE !!,"Observed reactions must have at least one observation entry.",!,"If this reaction is incorrect then enter a date and then proceed",!,"to mark it as entered in error.",!
- +2 QUIT
- +3 ;
- MISSREQ() ;Function determines if required data is missing
- +1 NEW GMRA0,TYPE
- +2 ;Entry not found
- SET GMRA0=$GET(^GMR(120.8,+$GET(GMRAPA),0))
- IF GMRA0=""
- QUIT 1
- +3 ;Get observed/historical
- SET TYPE=$PIECE(GMRA0,U,6)
- +4 ;Type not entered
- IF TYPE=""
- QUIT 1
- +5 ;Historical has no requirements
- IF TYPE="h"
- QUIT 0
- +6 ;Missing obs date/time or sign/symptom or required comment
- IF TYPE="o"
- IF '$DATA(^GMR(120.85,"C",GMRAPA))!('$ORDER(^GMR(120.85,+$ORDER(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM)
- QUIT 1
- +7 QUIT 0
- +8 ;
- REQCOM() ;Function determines if comments required
- +1 IF '$DATA(GMRASITE)
- DO SITE^GMRAUTL
- +2 ;Comments required?
- IF +$PIECE(^GMRD(120.84,+GMRASITE,0),U,4)=0
- QUIT 1
- +3 IF $ORDER(^GMR(120.8,GMRAPA,26,0))
- QUIT 1
- +4 QUIT 0
- +5 ;
- GMRACHK(GMRAPA) ;
- +1 ;Send a warning MailMan message if the VA DRUG CLASS field is empty.
- +2 ;Get the first, if any,VA DRUG CLASS entries for this agent.
- +3 NEW PATALLER,VADRCL1,PATNAME,REAC,REACTS,LINE
- +4 NEW PATIEN,SSN,LAST4
- +5 DO GETS^DIQ(120.8,GMRAPA_",","**","E","PATALLER")
- +6 ;mod by CAS - to skip all but "D" Drug type reactions
- +7 IF $PIECE($GET(^GMR(120.8,GMRAPA,0)),"^",20)'["D"
- QUIT
- +8 SET VADRCL1=$GET(PATALLER(120.803,"1,"_GMRAPA_",",.01,"E"))
- +9 SET PATNAME=$GET(PATALLER(120.8,GMRAPA_",",.01,"E"))
- +10 SET PATIEN=$$GET1^DIQ(120.8,GMRAPA,.01,"I")
- +11 SET SSN=$$GET1^DIQ(2,PATIEN,.09,"E")
- +12 SET LAST4=$EXTRACT(PATNAME,1,1)_$EXTRACT(SSN,6,9)
- +13 IF '$GET(GMRAERR)
- IF (VADRCL1="")
- IF (PATNAME'="")
- Begin DoDot:1
- +14 KILL ^XTMP("GMRACHK",$JOB)
- +15 SET LINE=1
- +16 SET ^XTMP("GMRACHK",$JOB,LINE)="The following allergy/adverse reaction may need a VA DRUG CLASS added"
- +17 SET LINE=LINE+1
- +18 SET ^XTMP("GMRACHK",$JOB,LINE)="for the following Patient:"
- +19 SET LINE=LINE+1
- +20 SET ^XTMP("GMRACHK",$JOB,LINE)=""
- +21 SET LINE=LINE+1
- +22 SET ^XTMP("GMRACHK",$JOB,LINE)="Patient: "_PATNAME
- +23 SET LINE=LINE+1
- +24 SET ^XTMP("GMRACHK",$JOB,LINE)="LAST4: "_LAST4
- +25 SET LINE=LINE+1
- +26 SET ^XTMP("GMRACHK",$JOB,LINE)="Reactant: "_$GET(PATALLER(120.8,GMRAPA_",",.02,"E"))
- +27 SET LINE=LINE+1
- +28 ;Build a pretty string of reactions
- +29 SET REAC=1
- +30 SET REACTS=$GET(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
- +31 SET REAC=REAC+1
- +32 FOR
- if '$DATA(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
- QUIT
- Begin DoDot:2
- +33 SET REACTS=REACTS_", "_$GET(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
- +34 SET REAC=REAC+1
- End DoDot:2
- +35 SET ^XTMP("GMRACHK",$JOB,LINE)="Reactions: "_REACTS
- +36 SET LINE=LINE+1
- +37 SET ^XTMP("GMRACHK",$JOB,LINE)="OBS/HIS: "_$GET(PATALLER(120.8,GMRAPA_",",6,"E"))
- +38 SET LINE=LINE+1
- +39 SET ^XTMP("GMRACHK",$JOB,LINE)="Location: "_$$GET1^DIQ(405,$$GET1^DIQ(2,DFN,.102,"I"),.06,"E")
- +40 SET LINE=LINE+1
- +41 SET XMDUZ=DUZ
- +42 SET XMTEXT="^XTMP(""GMRACHK"","_$JOB_","
- +43 IF $GET(DUZ(2))=""
- SET DUZ(2)=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
- +44 SET XMSUB="ALLERGY/ADVERSE REACTION WITHOUT VA DRUG CLASS ("
- +45 SET XMSUB=XMSUB_$PIECE($$NS^XUAF4(DUZ(2)),U)_")"
- +46 SET XMY("G.ADVERSE_ALLERGY_WARNING")=""
- +47 DO ^XMD
- +48 KILL ^XTMP("GMRACHK",$JOB)
- End DoDot:1
- +49 QUIT
- +50 ;
- MEDCHK ; NSR 20070203
- +1 NEW GMRAMCHK
- +2 WRITE !!,?2,"Checking new allergy against the patient's active medication profile . . . "
- +3 DO CHKMEDS^ORWDAL32(.GMRAMCHK,$PIECE(GMRAPA(0),"^"),$PIECE(GMRAPA(0),"^",2))
- +4 IF GMRAMCHK'>0
- WRITE !!,?2,"No conflicts were discovered.",!
- KILL GMRAMCHK
- QUIT
- +5 IF GMRAMCHK>0
- Begin DoDot:1
- +6 NEW GMRADA,GMRAYN,GMRAPROV,GMRASEND,GMRASLST,GMRALST,GMRAORD,GMRADUZ,GMRAOUT
- +7 WRITE !!,?2,"The following Active Orders contain "_$PIECE(GMRAPA(0),"^",2)_":"
- +8 SET GMRADA=""
- +9 FOR
- SET GMRADA=$ORDER(GMRAMCHK(GMRADA))
- if GMRADA=""
- QUIT
- IF $DATA(GMRAMCHK(GMRADA))
- Begin DoDot:2
- +10 WRITE !!,$PIECE(GMRAMCHK(GMRADA),"^",3)_" (Order #"_$PIECE(GMRAMCHK(GMRADA),"^")_") An alert will be sent to:"
- +11 DO GETPROV^ORWDAL32(.GMRAPROV,$PIECE(GMRAMCHK(GMRADA),"^"),+$GET(DFN))
- +12 NEW PRVDA
- SET PRVDA=""
- +13 FOR
- SET PRVDA=$ORDER(GMRAPROV(PRVDA))
- if PRVDA=""
- QUIT
- IF $DATA(GMRAPROV(PRVDA))
- Begin DoDot:3
- +14 SET GMRASLST($PIECE(GMRAMCHK(GMRADA),"^"),$PIECE(GMRAPROV(PRVDA),";"))=GMRAPROV(PRVDA)
- +15 WRITE !?3,$PIECE(GMRAPROV(PRVDA),"^",2)," - ",$PIECE(GMRAPROV(PRVDA),"^",3)
- End DoDot:3
- +16 KILL GMRAPROV
- End DoDot:2
- +17 WRITE !!
- +18 SET (GMRAOUT,GMRAYN)=0
- DO ASK^GMRAUTL("Do you wish to send the alert(s) to additional recipients? ",.GMRAOUT,.GMRAYN)
- if GMRAOUT
- QUIT
- +19 IF GMRAYN
- DO ADDSTHR(.GMRALST)
- +20 IF $DATA(GMRASLST)
- SET GMRAORD=""
- FOR
- SET GMRAORD=$ORDER(GMRASLST(GMRAORD))
- if GMRAORD=""
- QUIT
- IF $DATA(GMRASLST(GMRAORD))
- Begin DoDot:2
- +21 KILL GMRAPROV
- +22 SET GMRAPROV=""
- +23 IF $DATA(GMRALST)
- MERGE GMRAPROV=GMRALST
- +24 DO SENDALRT^ORWDAL32(.GMRASEND,GMRAORD,.GMRAPROV)
- End DoDot:2
- +25 KILL GMRASEND,GMRASLST
- End DoDot:1
- +26 KILL GMRAMCHK
- +27 QUIT
- +28 ;
- ADDSTHR(GMRALST) ; NSR 20070203
- +1 KILL GMRALST
- +2 NEW DIC,I,GMRAYN,GMRAON,GMRANOTE,GMRAOUT,Y
- +3 SET GMRAYN=0
- +4 ;NEW ALLERGY ENTERED/ACTIVE MED notification
- SET GMRANOTE=88
- +5 FOR I=1:1
- Begin DoDot:1
- +6 SET DIC="^VA(200,"
- SET DIC(0)="AEBQ"
- +7 SET DIC("A")="Enter Recipient's Name: "
- DO ^DIC
- +8 IF +Y>0
- Begin DoDot:2
- +9 SET GMRAON=$PIECE($$ONOFF^ORB3USER(GMRANOTE,+Y,"","",""),U,1)
- +10 IF GMRAON="OFF"
- WRITE !!," User is unable to receive the notification!",!
- QUIT
- +11 SET GMRALST($PIECE(Y,"^"))=$PIECE(Y,"^")_";VA(200,"_"^"_$PIECE(Y,"^",2)
- KILL DIC,Y
- End DoDot:2
- +12 SET (GMRAOUT,GMRAYN)=0
- DO ASK^GMRAUTL("Add another recipient? ",.GMRAOUT,.GMRAYN)
- if GMRAOUT
- QUIT
- End DoDot:1
- if 'GMRAYN
- QUIT
- +13 QUIT
- +14 ;
- XQOR ; GMRA EDIT VERIFIED DATA event driver ;P68
- +1 NEW X
- SET X=+$ORDER(^ORD(101,"B","GMRA EDIT VERIFIED DATA",0))_";ORD(101,"
- +2 if 'X
- QUIT
- if '$GET(GMRAPA)
- QUIT
- +3 if '$DATA(GMRAPA(0))
- SET GMRAPA(0)=$GET(^GMR(120.8,+GMRAPA,0))
- +4 IF $DATA(GMRAPA1)
- Begin DoDot:1
- +5 if $GET(GMRAPA1)>0
- SET GMRAPA1(0)=$GET(^GMR(120.85,+GMRAPA1,0))
- +6 ; cleanup GMRAPA1 if no selection (carried over from last edit)
- +7 IF $GET(GMRAPA1)<0!($PIECE(GMRAPA1(0),U,15)'=GMRAPA)
- KILL GMRAPA1
- End DoDot:1
- +8 if X
- DO EN^XQOR
- +9 QUIT