source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRANKA.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1GMRANKA ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT NKA DRIVE ;10/12/06 11:03
2 ;;4.0;Adverse Reaction Tracking;**2,21,36**;Mar 29, 1996;Build 9
3NKA(DFN) ;See if patient has reaction on file
4 ; Input Variables:
5 ; DFN = Patient Internal Entry Number
6 ;
7 ; Output Variables:
8 ; GMA = 1 Patient has known reaction
9 ; 0 Patient has No known reaction
10 ; Null Patient has never been asked about reaction
11 S GMA=""
12 S GMA=$P($G(^GMR(120.86,DFN,0)),U,2)
13 Q GMA
14 ;
15NKAASK(DFN,GMRAOUT) ; Ask a Patient if patient has any known allergens
16 ; Input Variables
17 ; DFN = Patient Internal entry number
18 ; GMRAOUT = Up Caret or time out flag
19 ;
20 ;Ask if patient has allergies
21 N DIR,Y,DIROUT,DTOUT,DIRUT,DUOUT,GMAOLD
22 S GMAOLD=$P($G(^GMR(120.86,DFN,0)),U,2)
23 S DIR(0)="120.86,1^AO^I Y=0&'$$NKASCR^GMRANKA(DFN) D INFO^GMRANKA K X"
24 S DIR("A")="Does this patient have any known allergies or adverse reactions? "
25 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")
26 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
27 D ^DIR
28 I $G(X)="@" D:GMAOLD=0 CLN W:GMAOLD=0 !,"Assessment deleted." Q ;21 Allow removal of NKA
29 I $D(DTOUT)!$D(DIROUT) S GMRAOUT=1 Q ;36
30 I $D(DUOUT) S GMRAOUT=2 Q ;36
31 ; User Hits return and doesn't answer question
32 I Y="",GMAOLD="" Q ;36
33 I Y'="",GMAOLD'=Y D
34 . N DIE,DA,DR
35 . S DIE="^GMR(120.86,",DA=DFN,DR=$S(GMAOLD="":(".01////"_DFN_";"),1:"")_"1////"_Y_";2////"_DUZ_";3///NOW" ;36
36 . D ^DIE
37 . Q
38 Q
39CLN ; Clean out entries that have not been answered.
40 S DIK="^GMR(120.86,",DA=DFN D ^DIK K DIK,DA
41 ;W !?20,"Patient will still be listed as not being",!?20,"asked about Allergies/Adverse Reactions."
42 Q
43INFO ; Info string
44 N GMASTR
45 S GMASTR(1)="Currently this patient has Causative Agents on file."
46 S GMASTR(2)="You will have to answer YES to this question and then"
47 S GMASTR(3)="indicate that each of the Causative Agents are incorrect."
48 S GMASTR(4)="Then you will be reasked this question and will be able"
49 S GMASTR(5)="to enter NO."
50 D WRITE^GMRADSP8(1,0,$C(7))
51 D WRITE^GMRADSP8(1,10,.GMASTR)
52 Q
53NKASCR(DFN) ; Is Patient NKA (No Known Allergy)
54 ; Input Variable:
55 ; DFN = Patient DFN in Patient file
56 ;
57 ; Output Variable:
58 ; GMA = 1 Patient is True NKA
59 ; = 0 Patient has a reaction in file 120.8
60 ;
61 ; This code will screen out Entered in Error entries
62 S GMA=1
63 N GMAX
64 S GMAX=0
65 F S GMAX=$O(^GMR(120.8,"B",DFN,GMAX)) Q:GMAX<1 D Q:'GMA
66 .I +$G(^GMR(120.8,GMAX,"ER")) Q
67 .S GMA=0
68 .Q
69 Q GMA
70 ;
71DELNKA ;Remove assessment of NKA for a selected patient
72 N Y,DFN,DIR,DIC
73 S DIC=120.86,DIC(0)="AEMQZ",DIC("A")="Select PATIENT NAME: " D ^DIC Q:Y=-1
74 S DFN=+Y
75 W !
76 I $$NKA^GMRANKA(DFN)'=0 W !,"This patient doesn't currently have an assessment of NKA." Q
77 S DIR(0)="Y",DIR("A")="Delete NKA assessment for patient "_$G(Y(0,0)),DIR("B")="NO"
78 S DIR("?")="Enter Y to delete the NKA assessment and return the patient to a 'not assessed' status. Enter N to cancel this action."
79 D ^DIR
80 I Y=1 D CLN^GMRANKA W "...Done"
81 Q
Note: See TracBrowser for help on using the repository browser.