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

GMRANKA.m

Go to the documentation of this file. 
  1. GMRANKA ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;01-Aug-2013 16:39;DU
  1.  ;;4.0;Adverse Reaction Tracking;**2,21,36,1007**;Mar 29, 1996;Build 18
  1. NKA(DFN) ;See if patient has reaction on file
  1.  ;  Input Variables:
  1.  ;       DFN = Patient Internal Entry Number
  1.  ;
  1.  ;  Output Variables:
  1.  ;       GMA = 1 Patient has known reaction
  1.  ;             0 Patient has No known reaction
  1.  ;             Null Patient has never been asked about reaction
  1.  S GMA=""
  1.  S GMA=$P($G(^GMR(120.86,DFN,0)),U,2)
  1.  Q GMA
  1.  ;
  1. NKAASK(DFN,GMRAOUT) ; Ask a Patient if patient has any known allergens
  1.  ;  Input Variables
  1.  ;     DFN = Patient Internal entry number
  1.  ;  GMRAOUT = Up Caret or time out flag
  1.  ;
  1.  ;Ask if patient has allergies
  1.  N DIR,Y,DIROUT,DTOUT,DIRUT,DUOUT,GMAOLD,SNOMED
  1.  S GMAOLD=$P($G(^GMR(120.86,DFN,0)),U,2)
  1.  S DIR(0)="120.86,1^AO^I Y=0&'$$NKASCR^GMRANKA(DFN) D INFO^GMRANKA K X"
  1.  S DIR("A")="Does this patient have any known allergies or adverse reactions? "
  1.  S DIR("B")=$S($P($G(^GMR(120.86,DFN,0)),U,2)=1:"Yes",$P($G(^GMR(120.86,DFN,0)),U,2)=0:"No",1:"") K:DIR("B")="" DIR("B")
  1.  S DIR("?")=$S(GMAOLD=0:"You may also enter @ to delete a previous NKA assessment and return the patient to a 'not assessed' state.  Use this if the NKA assessment was previously incorrectly entered.",1:"") ;21
  1.  D ^DIR
  1.  I $G(X)="@" D:GMAOLD=0 CLN W:GMAOLD=0 !,"Assessment deleted." Q  ;21 Allow removal of NKA
  1.  I $D(DTOUT)!$D(DIROUT) S GMRAOUT=1 Q  ;36
  1.  I $D(DUOUT) S GMRAOUT=2 Q  ;36
  1.  ; User Hits return and doesn't answer question
  1.  I Y="",GMAOLD="" Q  ;36
  1.  I Y'="",GMAOLD'=Y D
  1.  . ;Patch 1007 for SNOMED
  1.  . N DIE,DA,DR
  1.  . I Y=0 S SNOMED=160244002
  1.  . I Y=1 S SNOMED="@"
  1.  . S DIE="^GMR(120.86,",DA=DFN
  1.  . S DR=$S(GMAOLD="":(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW;9999999.01///"_SNOMED ;36
  1.  . D ^DIE
  1.  . Q
  1.  Q
  1. CLN ; Clean out entries that have not been answered.
  1.  S DIK="^GMR(120.86,",DA=DFN D ^DIK K DIK,DA
  1.  ;W !?20,"Patient will still be listed as not being",!?20,"asked about Allergies/Adverse Reactions."
  1.  Q
  1. INFO ; Info string
  1.  N GMASTR
  1.  S GMASTR(1)="Currently this patient has Causative Agents on file."
  1.  S GMASTR(2)="You will have to answer YES to this question and then"
  1.  S GMASTR(3)="indicate that each of the Causative Agents are incorrect."
  1.  S GMASTR(4)="Then you will be reasked this question and will be able"
  1.  S GMASTR(5)="to enter NO."
  1.  D WRITE^GMRADSP8(1,0,$C(7))
  1.  D WRITE^GMRADSP8(1,10,.GMASTR)
  1.  Q
  1. NKASCR(DFN) ; Is Patient NKA (No Known Allergy)
  1.  ;   Input Variable:
  1.  ;        DFN = Patient DFN in Patient file
  1.  ;
  1.  ;  Output Variable:
  1.  ;        GMA = 1 Patient is True NKA
  1.  ;            = 0 Patient has a reaction in file 120.8
  1.  ;
  1.  ; This code will screen out Entered in Error entries
  1.  S GMA=1
  1.  N GMAX
  1.  S GMAX=0
  1.  F  S GMAX=$O(^GMR(120.8,"B",DFN,GMAX)) Q:GMAX<1  D  Q:'GMA
  1.  .I +$G(^GMR(120.8,GMAX,"ER")) Q
  1.  .S GMA=0
  1.  .Q
  1.  Q GMA
  1.  ;
  1. DELNKA ;Remove assessment of NKA for a selected patient
  1.  N Y,DFN,DIR,DIC
  1.  S DIC=120.86,DIC(0)="AEMQZ",DIC("A")="Select PATIENT NAME: " D ^DIC Q:Y=-1
  1.  S DFN=+Y
  1.  W !
  1.  I $$NKA^GMRANKA(DFN)'=0 W !,"This patient doesn't currently have an assessment of NKA." Q
  1.  S DIR(0)="Y",DIR("A")="Delete NKA assessment for patient "_$G(Y(0,0)),DIR("B")="NO"
  1.  S DIR("?")="Enter Y to delete the NKA assessment and return the patient to a 'not assessed' status.  Enter N to cancel this action."
  1.  D ^DIR
  1.  I Y=1 D CLN^GMRANKA W "...Done"
  1.  Q