source: FOIAVistA/tag/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAMCB.m@ 628

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1GMRAMCB ;HIRMFO/WAA-MARK CHART & ID BAND FIELD EDIT ;9/22/06 12:52
2 ;;4.0;Adverse Reaction Tracking;**21,36**;Mar 29, 1996;Build 9
3EN3 ;Entry for EDIT CHART & ID BAND option
4 K GMRALL S GMRAOUT=0 D GETAL^GMRAMCB1 I GMRAOUT!'$D(GMRALL) L:DFN>0 -^GMR(120.8,"B",DFN) G Q3
5 D EN5 D:'GMRAOUT EN7
6 L -^GMR(120.8,"B",DFN)
7 G Q3
8EN4(GMRALL,DFN) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT
9 D EN5 D:'GMRAOUT EN7 Q
10EN5 ;THIS IS THE ENTRY POINT TO BY PASS THE FORMAL LIST AGAIN
11 D VAD^GMRAUTL1(DFN,"",.GMRALOC,.GMRANAM,"",.GMRASSN)
12 N REQ S REQ=0,GMRAPA=0 F S GMRAPA=$O(GMRALL(GMRAPA)) Q:'+GMRAPA!(REQ) S:'$O(^GMR(120.8,GMRAPA,14,0)) REQ=1 ;36
13 S GMRATYPE="B",I=0,GMRAPA=0 W !,"This session you have CHOSEN:" F S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1 S I=I+1 W !,?5,$P($G(^GMR(120.8,GMRAPA,0)),U,2)
14 W ! D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0)),GMRAOUT=0
15 F GMRAMARK="13^Chart(s)","14^ID Band" S GMRAM2=$P(GMRAMARK,"^",2),GMRAM1=$P(GMRAMARK,"^") D Q:GMRAOUT
16 .I GMRAM1=14,($P(GMRASITE(0),U,5)=0!(GMRALOC=""))!('REQ) Q ;36
17 .S GMRANULL=0 F S %=0 D I %!(%Y="") Q
18 ..I GMRAM1=13 S %=1,%Y="Y" Q ;21 Marked on chart set to YES automatically
19 ..W !,$S(GMRAM1=14:"Has",1:"Have")," the "_GMRAM2_" been marked for",$S(I>1:" these CAUSATIVE AGENTS",1:" this CAUSATIVE AGENT") D YN^DICN
20 ..Q:%Y=""
21 ..S:%<0 %=2,GMRAOUT=1 Q:% W !?4,"ANSWER YES IF THE "_GMRAM2_" HAS BEEN MARKED, ELSE ANSWER NO."
22 ..Q
23 .I %=2!(%Y="") Q
24 .S GMRAPA=0 F S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1 D
25 ..I '$D(^GMR(120.8,GMRAPA,GMRAM1,0)) S ^(0)="^120.8"_GMRAM1_"DA^^"
26 ..D NOW^%DTC K DO,DD,DINUM S X=%,DIC="^GMR(120.8,"_GMRAPA_","_GMRAM1_",",DIC(0)="L",DLAYGO=120.8,DA(1)=GMRAPA,DIC("DR")="1////"_DUZ D FILE^DICN K DIC,DLAYGO
27 ..Q
28 .Q
29 Q
30EN6(GMRALL,DFN,GMRATYPE) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT
31 N GMRAOUT,%,%Y S GMRAOUT=0
32 D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
33EN7 I $D(%Y),%Y="" Q
34 S GMRAPA=0 F S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1 D
35 .I $O(^GMR(120.8,GMRAPA,13,0))&($P(GMRASITE(0),U,5)=0!$O(^GMR(120.8,GMRAPA,14,0))!(GMRALOC="")) Q
36 .S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) D BULLT^GMRASEND
37 .Q
38 Q
39Q3 ; CLEAN UP AFTER EN3
40 D KILL^XUSCLEAN
41 Q
42HELP ;THIS ROUTINE WILL LIST ALL THE SELECTED ALLERGIES AND ALL THE
43 ;CURRENT SELECTED ALLERGIES
44 S GMRAPA=0 I '$D(GMRALL) W !,"No CAUSATIVE AGENTS have been selected for this patient."
45 E W !,"You have selected the following CAUSATIVE AGENTS:",! S GMRAPA=0 F S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1 W !,?5,$P($G(^GMR(120.8,GMRAPA,0)),U,2)
46 K GMRAPA
47 D HANGT^GMRAPEH0
48HLP1 ;LIST ALL ALLERGIES
49 W !,"You may choose CAUSATIVE AGENTS from the following list for this patient:"
50 N DIC
51 I '$D(^GMR(120.8,"B",DFN)) W !?4,"There are no reactions on file for this patient." Q
52 D HLP12085^GMRAU851(DFN,"'+$G(^GMR(120.8,+GMRAX,""ER""))")
53 D HANGT^GMRAPEH0
54 Q
Note: See TracBrowser for help on using the repository browser.