Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAPEM0

GMRAPEM0.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to $$ONOFF^ORB3USER in ICR #7211
  1. ; Reference to CHKMEDS^ORWDAL32,GETPROV^ORWDAL32,SENDALRT^ORWDAL32 in ICR #6756
  1. ;
  1. EN11 ; Entry point for GMRA USER E/E PAT REC DATA option
  1. ; GMRAUSER is a flag that indicates that this is a User
  1. ; If user has Verifier Key then user will act normal
  1. I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
  1. ;
  1. EN1 ; Entry for ENTER/EDIT PATIENT REACTION DATA option
  1. ; EDIT PATIENT A/AR (DFN UNK.)
  1. S GMRAOUT=0
  1. W @IOF D PAT^GMRAPAT ; Select A Patient
  1. D:'GMRAOUT EN21 G:'GMRAOUT EN1
  1. K DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER
  1. D EXIT,EN1^GMRAKILL
  1. Q
  1. ;
  1. EN21 ; Process patient data and determine if patient is NKA
  1. S GMRAOUT=$G(GMRAOUT,0)
  1. ; check patient assessment before enter/edit reaction
  1. I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
  1. .N DA,DIK
  1. .S DIK="^GMR(120.86,",DA=DFN D ^DIK
  1. .Q
  1. I '$$NKA^GMRANKA(DFN) D NKAASK^GMRANKA(DFN,.GMRAOUT) Q:GMRAOUT I '$$NKA^GMRANKA(DFN) Q
  1. L +^XTMP("GMRAED",DFN):1 I '$T D MESS^GMRAGUI1 Q ;21
  1. S GMRAOUT=0
  1. D:'GMRAOUT SELECT
  1. I $G(GMRAPA)'>0 S GMRAOUT=0
  1. S GMRARP=1 I 'GMRAOUT D
  1. .D ASK^GMRAUTL("Enter another Causative Agent? ",.GMRAOUT,.GMRARP)
  1. .I 'GMRARP S GMRACNT=$O(^TMP($J,"GMRASF","B"),-1) D
  1. ..I GMRACNT D SIGNOFF^GMRASIGN
  1. ..I 'GMRAOUT D IDBAND^GMRASIGN
  1. ..I GMRAOUT S GMRAOUT=2-GMRAOUT D:GMRAOUT&($D(^TMP($J,"GMRASF"))) ALERT^GMRASIGN K ^TMP($J,"GMRASF"),GMRACNT
  1. ..Q
  1. .Q
  1. I GMRARP,'GMRAOUT K GMRARP L -^XTMP("GMRAED",DFN) G EN21 ;21
  1. K GMRARP
  1. ; check patient assessment when exiting enter/edit reaction
  1. I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
  1. .N DA,DIK
  1. .S DIK="^GMR(120.86,",DA=DFN D ^DIK
  1. .Q
  1. L -^XTMP("GMRAED",DFN) ;21
  1. Q
  1. ;
  1. EN2 ; EDIT PATIENT A/AR (DFN KNOWN)
  1. ; Called from the GMRAOR ALLERGY ENTER/EDIT protocol
  1. I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
  1. N GMRAOUT
  1. D EN21 D
  1. .;N GMRAOUT
  1. .D EXIT,EN1^GMRAKILL
  1. .Q
  1. K GMA,GMRARET,GMRAUSER
  1. Q
  1. ;
  1. ALERT ; PROCESS ALERTS FOR ART
  1. N DFN,GMRAPA,GMRACNT,GMRAOUT,GMRANEW,GMRAUSER
  1. S (GMRACNT,GMRAOUT,GMRANEW)=0 D
  1. . I $G(XQADATA)="" S XQAKILL=0 Q
  1. . S DFN=$P(XQADATA,U),GMRAPA=$P(XQADATA,U,2),GMRAUSER=$P(XQADATA,U,3) Q:'DFN!'GMRAPA
  1. . I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) K GMRAUSER
  1. . S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
  1. . I $P(GMRAPA(0),U,12) D Q
  1. . . W !,"This reaction has been signed off.",$C(7)
  1. . . D HANGT^GMRAPEH0
  1. . . S XQAKILL=0
  1. . . Q
  1. . D EDIT^GMRAPEM4
  1. . D UPDATE^GMRAPEM3
  1. . I '$P(GMRAPA(0),U,12) D SIGNOFF^GMRASIGN
  1. . I GMRAOUT S GMRAOUT=2-GMRAOUT K XQAKILL
  1. . E D
  1. . .I $P(GMRAPA(0),U,12) S XQAKILL=0
  1. . .I '$P(GMRAPA(0),U,12) K XQAKILL
  1. . D EXIT,EN1^GMRAKILL
  1. . Q
  1. Q
  1. ;
  1. SELECT ;Select a patient reaction
  1. S GMRACNT=0 D 1^VADPT
  1. 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
  1. K GMRADUP S GMRALAGO=1
  1. D REACT^GMRAPAT(DFN) ; Load all reaction for this patient.
  1. D EN1^GMRAPES0
  1. I GMRAPA>0 D TYPE D
  1. .I $G(GMRAEVT) D XQOR ;post event if anything edited ;P68
  1. .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
  1. .I GMRAERR D ERR^GMRAPEM3 Q ;The reaction was entered in error
  1. .I $P(GMRAPA(0),U,12) D SIGNED^GMRAPEM3 Q ;The reaction has been signed
  1. .; Reaction is a new reaction or Update data
  1. .I GMRANEW D GMRACHK^GMRAPEM0(GMRAPA)
  1. .I GMRANEW D MEDCHK ; NSR 20070203
  1. .D UPDATE^GMRAPEM3
  1. .Q
  1. K GMRAEVT
  1. Q
  1. ;
  1. TYPE ; Select the type of the process to use this reaction
  1. S GMRAERR=0,GMRAEVT=0 K GMRAPA1
  1. ; If reaction is not new check to see if user want to enter in error
  1. I 'GMRANEW W @IOF N GMRADFN D EN1^GMRAPEE0 I GMRAERR!GMRAOUT Q
  1. ;If reaction is observed and signed off
  1. I $P(GMRAPA(0),U,6)="o",$P(GMRAPA(0),U,12) D Q:GMRAOUT
  1. .Q:$G(GMRAUSER,0)
  1. .N GMRARP
  1. .S GMRARP=0 D ASK^GMRAUTL("DO YOU WISH TO EDIT OBSERVED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
  1. .Q:'GMRARP ;Observed data
  1. .N GMRAOD S GMRAOD=$D(^GMR(120.85,"C",GMRAPA)) ;Existing observation data?
  1. OBSDATE .;
  1. .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)
  1. .I 'GMRAOUT,GMRAPA1>0 D EN2^GMRAROBS S:$P($G(^GMR(120.8,GMRAPA,0)),U,16)=1 GMRAEVT=1 ;P68
  1. .I '$D(^GMR(120.85,"C",GMRAPA)),$G(GMRANEW)!('$G(GMRANEW)&($G(GMRAOD))) D OBSPROB S GMRAOUT=0 G OBSDATE
  1. .Q
  1. ;Verify data
  1. 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
  1. .K GMRAVER S GMRAVER=0
  1. .N GMRAPRNT D EN1^GMRAVFY K GMRALLER,GMRAMEC,GMRAY
  1. .I $P($G(^GMR(120.8,GMRAPA,0)),U,16)=1 S GMRASLL(GMRAPA)=1
  1. .Q
  1. ;EDIT Verified data
  1. I 'GMRAERR,$P($G(^GMR(120.8,GMRAPA,0)),U,16)=1,$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q:GMRAOUT
  1. .Q:$G(GMRAVER)=1
  1. .N GMRARP
  1. .S GMRARP=0
  1. .D ASK^GMRAUTL("DO YOU WISH TO EDIT VERIFIED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
  1. .I GMRARP D SITE^GMRAUTL,EN1^GMRAPED0 S GMRAEVT=1 ;P68
  1. .Q
  1. ;if the reaction is new or not signed off
  1. I '$P(GMRAPA(0),U,12) D
  1. .D EDIT^GMRAPEM4
  1. .I $P($G(^GMR(120.8,GMRAPA,0)),U,16) S GMRASLL(GMRAPA)=1
  1. .Q
  1. Q
  1. ;
  1. EXIT S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRASF","B",GMRAPA)) Q:GMRAPA<1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
  1. K ^TMP($J,"GMRASF")
  1. K ^TMP($J,"GMRALST")
  1. Q
  1. ;
  1. DELETE ;Delete entry if required information is not entered - section added in 17
  1. N DA,DIK,GMRAPA1
  1. W !!,"Entry process not completed, deleting entry...",!
  1. S GMRAPA1=$O(^GMR(120.85,"C",GMRAPA,0))
  1. I GMRAPA1,$G(^GMR(120.85,GMRAPA1,0))="" K ^GMR(120.85,"C",GMRAPA,GMRAPA1)
  1. I GMRAPA1 S DIK="^GMR(120.85,",DA=GMRAPA1 D ^DIK D UNLOCK^GMRAUTL(120.85,GMRAPA1)
  1. I GMRAPA S DIK="^GMR(120.8,",DA=GMRAPA D ^DIK D UNLOCK^GMRAUTL(120.8,GMRAPA)
  1. Q
  1. ;
  1. OBSPROB ;Display help information for missing observed date/time entry
  1. 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.",!
  1. Q
  1. ;
  1. MISSREQ() ;Function determines if required data is missing
  1. N GMRA0,TYPE
  1. S GMRA0=$G(^GMR(120.8,+$G(GMRAPA),0)) I GMRA0="" Q 1 ;Entry not found
  1. S TYPE=$P(GMRA0,U,6) ;Get observed/historical
  1. I TYPE="" Q 1 ;Type not entered
  1. I TYPE="h" Q 0 ;Historical has no requirements
  1. 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
  1. Q 0
  1. ;
  1. REQCOM() ;Function determines if comments required
  1. I '$D(GMRASITE) D SITE^GMRAUTL
  1. I +$P(^GMRD(120.84,+GMRASITE,0),U,4)=0 Q 1 ;Comments required?
  1. I $O(^GMR(120.8,GMRAPA,26,0)) Q 1
  1. Q 0
  1. ;
  1. GMRACHK(GMRAPA) ;
  1. ;Send a warning MailMan message if the VA DRUG CLASS field is empty.
  1. ;Get the first, if any,VA DRUG CLASS entries for this agent.
  1. N PATALLER,VADRCL1,PATNAME,REAC,REACTS,LINE
  1. N PATIEN,SSN,LAST4
  1. D GETS^DIQ(120.8,GMRAPA_",","**","E","PATALLER")
  1. ;mod by CAS - to skip all but "D" Drug type reactions
  1. I $P($G(^GMR(120.8,GMRAPA,0)),"^",20)'["D" Q
  1. S VADRCL1=$G(PATALLER(120.803,"1,"_GMRAPA_",",.01,"E"))
  1. S PATNAME=$G(PATALLER(120.8,GMRAPA_",",.01,"E"))
  1. S PATIEN=$$GET1^DIQ(120.8,GMRAPA,.01,"I")
  1. S SSN=$$GET1^DIQ(2,PATIEN,.09,"E")
  1. S LAST4=$E(PATNAME,1,1)_$E(SSN,6,9)
  1. I '$G(GMRAERR),(VADRCL1=""),(PATNAME'="") D
  1. . K ^XTMP("GMRACHK",$J)
  1. . S LINE=1
  1. . S ^XTMP("GMRACHK",$J,LINE)="The following allergy/adverse reaction may need a VA DRUG CLASS added"
  1. . S LINE=LINE+1
  1. . S ^XTMP("GMRACHK",$J,LINE)="for the following Patient:"
  1. . S LINE=LINE+1
  1. . S ^XTMP("GMRACHK",$J,LINE)=""
  1. . S LINE=LINE+1
  1. . S ^XTMP("GMRACHK",$J,LINE)="Patient: "_PATNAME
  1. . S LINE=LINE+1
  1. . S ^XTMP("GMRACHK",$J,LINE)="LAST4: "_LAST4
  1. . S LINE=LINE+1
  1. . S ^XTMP("GMRACHK",$J,LINE)="Reactant: "_$G(PATALLER(120.8,GMRAPA_",",.02,"E"))
  1. . S LINE=LINE+1
  1. . ;Build a pretty string of reactions
  1. . S REAC=1
  1. . S REACTS=$G(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
  1. . S REAC=REAC+1
  1. . F Q:'$D(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E")) D
  1. . . S REACTS=REACTS_", "_$G(PATALLER(120.81,REAC_","_GMRAPA_",",.01,"E"))
  1. . . S REAC=REAC+1
  1. . S ^XTMP("GMRACHK",$J,LINE)="Reactions: "_REACTS
  1. . S LINE=LINE+1
  1. . S ^XTMP("GMRACHK",$J,LINE)="OBS/HIS: "_$G(PATALLER(120.8,GMRAPA_",",6,"E"))
  1. . S LINE=LINE+1
  1. . S ^XTMP("GMRACHK",$J,LINE)="Location: "_$$GET1^DIQ(405,$$GET1^DIQ(2,DFN,.102,"I"),.06,"E")
  1. . S LINE=LINE+1
  1. . S XMDUZ=DUZ
  1. . S XMTEXT="^XTMP(""GMRACHK"","_$J_","
  1. . I $G(DUZ(2))="" S DUZ(2)=+$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1. . S XMSUB="ALLERGY/ADVERSE REACTION WITHOUT VA DRUG CLASS ("
  1. . S XMSUB=XMSUB_$P($$NS^XUAF4(DUZ(2)),U)_")"
  1. . S XMY("G.ADVERSE_ALLERGY_WARNING")=""
  1. . D ^XMD
  1. . K ^XTMP("GMRACHK",$J)
  1. Q
  1. ;
  1. MEDCHK ; NSR 20070203
  1. N GMRAMCHK
  1. W !!,?2,"Checking new allergy against the patient's active medication profile . . . "
  1. D CHKMEDS^ORWDAL32(.GMRAMCHK,$P(GMRAPA(0),"^"),$P(GMRAPA(0),"^",2))
  1. I GMRAMCHK'>0 W !!,?2,"No conflicts were discovered.",! K GMRAMCHK Q
  1. I GMRAMCHK>0 D
  1. . N GMRADA,GMRAYN,GMRAPROV,GMRASEND,GMRASLST,GMRALST,GMRAORD,GMRADUZ,GMRAOUT
  1. . W !!,?2,"The following Active Orders contain "_$P(GMRAPA(0),"^",2)_":"
  1. . S GMRADA=""
  1. . F S GMRADA=$O(GMRAMCHK(GMRADA)) Q:GMRADA="" I $D(GMRAMCHK(GMRADA)) D
  1. . . W !!,$P(GMRAMCHK(GMRADA),"^",3)_" (Order #"_$P(GMRAMCHK(GMRADA),"^")_") An alert will be sent to:"
  1. . . D GETPROV^ORWDAL32(.GMRAPROV,$P(GMRAMCHK(GMRADA),"^"),+$G(DFN))
  1. . . N PRVDA S PRVDA=""
  1. . . F S PRVDA=$O(GMRAPROV(PRVDA)) Q:PRVDA="" I $D(GMRAPROV(PRVDA)) D
  1. . . . S GMRASLST($P(GMRAMCHK(GMRADA),"^"),$P(GMRAPROV(PRVDA),";"))=GMRAPROV(PRVDA)
  1. . . . W !?3,$P(GMRAPROV(PRVDA),"^",2)," - ",$P(GMRAPROV(PRVDA),"^",3)
  1. . . K GMRAPROV
  1. . W !!
  1. . S (GMRAOUT,GMRAYN)=0 D ASK^GMRAUTL("Do you wish to send the alert(s) to additional recipients? ",.GMRAOUT,.GMRAYN) Q:GMRAOUT
  1. . I GMRAYN D ADDSTHR(.GMRALST)
  1. . I $D(GMRASLST) S GMRAORD="" F S GMRAORD=$O(GMRASLST(GMRAORD)) Q:GMRAORD="" I $D(GMRASLST(GMRAORD)) D
  1. . . K GMRAPROV
  1. . . S GMRAPROV=""
  1. . . I $D(GMRALST) M GMRAPROV=GMRALST
  1. . . D SENDALRT^ORWDAL32(.GMRASEND,GMRAORD,.GMRAPROV)
  1. . K GMRASEND,GMRASLST
  1. K GMRAMCHK
  1. Q
  1. ;
  1. ADDSTHR(GMRALST) ; NSR 20070203
  1. K GMRALST
  1. N DIC,I,GMRAYN,GMRAON,GMRANOTE,GMRAOUT,Y
  1. S GMRAYN=0
  1. S GMRANOTE=88 ;NEW ALLERGY ENTERED/ACTIVE MED notification
  1. F I=1:1 D Q:'GMRAYN
  1. . S DIC="^VA(200,",DIC(0)="AEBQ"
  1. . S DIC("A")="Enter Recipient's Name: " D ^DIC
  1. . I +Y>0 D
  1. . . S GMRAON=$P($$ONOFF^ORB3USER(GMRANOTE,+Y,"","",""),U,1)
  1. . . I GMRAON="OFF" W !!," User is unable to receive the notification!",! Q
  1. . . S GMRALST($P(Y,"^"))=$P(Y,"^")_";VA(200,"_"^"_$P(Y,"^",2) K DIC,Y
  1. . S (GMRAOUT,GMRAYN)=0 D ASK^GMRAUTL("Add another recipient? ",.GMRAOUT,.GMRAYN) Q:GMRAOUT
  1. Q
  1. ;
  1. XQOR ; GMRA EDIT VERIFIED DATA event driver ;P68
  1. N X S X=+$O(^ORD(101,"B","GMRA EDIT VERIFIED DATA",0))_";ORD(101,"
  1. Q:'X Q:'$G(GMRAPA)
  1. S:'$D(GMRAPA(0)) GMRAPA(0)=$G(^GMR(120.8,+GMRAPA,0))
  1. I $D(GMRAPA1) D
  1. . S:$G(GMRAPA1)>0 GMRAPA1(0)=$G(^GMR(120.85,+GMRAPA1,0))
  1. . ; cleanup GMRAPA1 if no selection (carried over from last edit)
  1. . I $G(GMRAPA1)<0!($P(GMRAPA1(0),U,15)'=GMRAPA) K GMRAPA1
  1. D:X EN^XQOR
  1. Q