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

GMRAFA1.m

Go to the documentation of this file.
  1. GMRAFA1 ;ISP/RFR - CORRECT ASSESSMENTS DETAIL;04/11/2013 07:13
  1. ;;4.0;Adverse Reaction Tracking;**48**;Mar 29, 1996;Build 13
  1. EN ; -- main entry point for GMRA ASSESS FIX DETAIL
  1. Q
  1. ;
  1. HDR ; -- header code
  1. Q:'+$G(DFN)
  1. N VADM,VAIN,ASSESS,IEN
  1. D DEM^VADPT,INP^VADPT
  1. S VALMHDR(1)=$$LJ^XLFSTR("Patient: "_VADM(1)_" ("_$P(VADM(2),"-",3)_")",$S(+$G(IOM)>0:IOM,1:80)-10," ")_$S($D(VAIN):" Inpatient",1:"Outpatient")
  1. S IEN=+$O(^GMR(120.86,"B",DFN,0))
  1. S:IEN>0 ASSESS=$P($G(^GMR(120.86,IEN,0)),U,2)
  1. S VALMHDR(2)="Assessment: "_$S(IEN=0:"None on file",ASSESS=0:"No known reactions",ASSESS=1:"Has known reactions",1:"<ENTRY NOT FOUND>")
  1. S VALMHDR(3)="Allergy Listing"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. Q:'+$G(DFN)
  1. D CLEAN^VALM10
  1. N IEN,TEXT
  1. S VALMCNT=0
  1. S IEN=0 F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:'IEN D
  1. .S VALMCNT=VALMCNT+1
  1. .S TEXT="",TEXT=$$SETFLD^VALM1(VALMCNT_".",TEXT,"LINENO")
  1. .S TEXT=$$SETFLD^VALM1($P($G(^GMR(120.8,IEN,0)),U,2),TEXT,"REACTANT")
  1. .S TEXT=$$SETFLD^VALM1($$EIE(IEN),TEXT,"ERROR")
  1. .D SET^VALM10(VALMCNT,TEXT,IEN)
  1. S:VALMCNT=0 VALMSG="No reactions found"
  1. Q
  1. ;
  1. EIE(IEN) ; -- return 'Entered in Error' text
  1. N RETURN
  1. S RETURN=$$GET1^DIQ(120.8,IEN_",",22)
  1. S RETURN=$S(RETURN'="":RETURN,1:"NO")
  1. Q RETURN
  1. ;
  1. HELP ; -- help code
  1. D FULL^VALM1
  1. W !!,"Use MA to reassess the patient for adverse reactions. The patient's current",!
  1. W "assessment appears in the upper-left corner of the screen.",!
  1. W !!,"Use RR to view a single reaction. After the reaction is displayed, the system",!
  1. W "will ask if you want to mark the reaction as 'Entered in Error'.",!
  1. W !!,"Use EE to mark all displayed reactions as 'Entered in Error'. Use extreme",!
  1. W "caution when performing a mass update. It is better to first view the reaction",!
  1. W "and then mark it as 'Entered in Error'.",!
  1. D WAIT^GMRAFX3
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D FULL^VALM1
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. RR ; -- review reaction
  1. Q:$$NOLOCK
  1. N DIC,DA,DIQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,GMRAPA,STATUS,GMRAITM
  1. D SELECT(.GMRAITM,"reactions")
  1. I 'GMRAITM S VALMSG="No reactions found" Q
  1. Q:GMRAITM<0
  1. S DA=+$O(@VALMAR@("IDX",GMRAITM,"")),DIC="^GMR(120.8,",DIQ(0)="CR"
  1. W ! D EN^DIQ
  1. S STATUS=$$EIE(DA)
  1. I STATUS="NO" D
  1. .S DIR(0)="YA"_U,DIR("A")="Would you like to mark this allergy as 'Entered in Error'? "
  1. .S DIR("B")="NO"
  1. .D ^DIR
  1. .I +$G(Y)>0 D
  1. ..S GMRAPA=DA
  1. ..D MEIE
  1. I STATUS'="NO" D WAIT^GMRAFX3
  1. K VALMSG
  1. Q
  1. ;
  1. UASSESS ; -- update assessment
  1. Q:$$NOLOCK
  1. D FULL^VALM1
  1. D NKAASK^GMRANKA(DFN)
  1. K VALMHDR,VALMSG
  1. D RE^VALM4
  1. Q
  1. ;
  1. ALLEE ; -- mark all allergies as entered in error
  1. Q:$$NOLOCK
  1. I VALMCNT=0 D Q
  1. .W !,"There are no reactions to mark."
  1. .S VALMSG="No reactions found"
  1. .D WAIT^GMRAFX3
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="YA"_U,DIR("A",1)="You are about to mark all of this patient's allergies as 'Entered in Error'."
  1. S DIR("A")="Do you want to continue? ",DIR("B")="NO"
  1. D ^DIR
  1. Q:$D(DIRUT)!($G(Y)<1)
  1. N GMRAPA,GMRAITM
  1. S GMRAITM=0 F S GMRAITM=$O(@VALMAR@("IDX",GMRAITM)) Q:'$G(GMRAITM) D
  1. .S GMRAPA=+$O(@VALMAR@("IDX",GMRAITM,""))
  1. .I '$P($G(^GMR(120.8,GMRAPA,"ER")),U) D
  1. ..S GMRAPA=+$O(@VALMAR@("IDX",GMRAITM,""))
  1. ..W !,"Marking "_$P($G(^GMR(120.8,GMRAPA,0)),U,2)_" as 'Entered in Error'...",!
  1. ..D MEIE
  1. Q
  1. MEIE ; -- mark allergy as entered in error
  1. D EIE^GMRAFX3
  1. D FLDTEXT^VALM10(GMRAITM,"ERROR",$$EIE(GMRAPA))
  1. K VALMHDR,VALMSG
  1. D WRITE^VALM10(GMRAITM)
  1. Q
  1. ;
  1. NOLOCK() ; -- determines if the user has a lock on the current patient
  1. N RETURN
  1. S RETURN=0
  1. I '$D(^XTMP("GMRAFA",DFN,DUZ)) S RETURN=1
  1. I $G(^XTMP("GMRAFA",DFN,DUZ))'=$J S RETURN=1
  1. I RETURN D
  1. .W !,"You no longer have a lock on this patient's records in this session.",!
  1. .W !,"Please reselect the patient."
  1. .S VALMBCK="Q"
  1. .D WAIT^GMRAFX3
  1. Q RETURN
  1. SELECT(RETURN,ENTITIES) ; -- select an item from the list
  1. S RETURN=-1
  1. I VALMCNT=0 D Q
  1. .W !,"There are no "_ENTITIES_" to select."
  1. .D WAIT^GMRAFX3
  1. .S RETURN=0
  1. N DIR,X,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="N^1:"_VALMCNT_":0"
  1. D ^DIR
  1. Q:$D(DIRUT)!($D(DIROUT))
  1. D FULL^VALM1
  1. S RETURN=Y
  1. Q
  1. ;