55 lines
2.8 KiB
Mathematica
55 lines
2.8 KiB
Mathematica
GMRAMCB ;HIRMFO/WAA-MARK CHART & ID BAND FIELD EDIT ;9/22/06 12:52
|
|
;;4.0;Adverse Reaction Tracking;**21,36**;Mar 29, 1996;Build 9
|
|
EN3 ;Entry for EDIT CHART & ID BAND option
|
|
K GMRALL S GMRAOUT=0 D GETAL^GMRAMCB1 I GMRAOUT!'$D(GMRALL) L:DFN>0 -^GMR(120.8,"B",DFN) G Q3
|
|
D EN5 D:'GMRAOUT EN7
|
|
L -^GMR(120.8,"B",DFN)
|
|
G Q3
|
|
EN4(GMRALL,DFN) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT
|
|
D EN5 D:'GMRAOUT EN7 Q
|
|
EN5 ;THIS IS THE ENTRY POINT TO BY PASS THE FORMAL LIST AGAIN
|
|
D VAD^GMRAUTL1(DFN,"",.GMRALOC,.GMRANAM,"",.GMRASSN)
|
|
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
|
|
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)
|
|
W ! D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0)),GMRAOUT=0
|
|
F GMRAMARK="13^Chart(s)","14^ID Band" S GMRAM2=$P(GMRAMARK,"^",2),GMRAM1=$P(GMRAMARK,"^") D Q:GMRAOUT
|
|
.I GMRAM1=14,($P(GMRASITE(0),U,5)=0!(GMRALOC=""))!('REQ) Q ;36
|
|
.S GMRANULL=0 F S %=0 D I %!(%Y="") Q
|
|
..I GMRAM1=13 S %=1,%Y="Y" Q ;21 Marked on chart set to YES automatically
|
|
..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
|
|
..Q:%Y=""
|
|
..S:%<0 %=2,GMRAOUT=1 Q:% W !?4,"ANSWER YES IF THE "_GMRAM2_" HAS BEEN MARKED, ELSE ANSWER NO."
|
|
..Q
|
|
.I %=2!(%Y="") Q
|
|
.S GMRAPA=0 F S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1 D
|
|
..I '$D(^GMR(120.8,GMRAPA,GMRAM1,0)) S ^(0)="^120.8"_GMRAM1_"DA^^"
|
|
..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
|
|
..Q
|
|
.Q
|
|
Q
|
|
EN6(GMRALL,DFN,GMRATYPE) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT
|
|
N GMRAOUT,%,%Y S GMRAOUT=0
|
|
D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
|
|
EN7 I $D(%Y),%Y="" Q
|
|
S GMRAPA=0 F S GMRAPA=$O(GMRALL(GMRAPA)) Q:GMRAPA<1 D
|
|
.I $O(^GMR(120.8,GMRAPA,13,0))&($P(GMRASITE(0),U,5)=0!$O(^GMR(120.8,GMRAPA,14,0))!(GMRALOC="")) Q
|
|
.S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) D BULLT^GMRASEND
|
|
.Q
|
|
Q
|
|
Q3 ; CLEAN UP AFTER EN3
|
|
D KILL^XUSCLEAN
|
|
Q
|
|
HELP ;THIS ROUTINE WILL LIST ALL THE SELECTED ALLERGIES AND ALL THE
|
|
;CURRENT SELECTED ALLERGIES
|
|
S GMRAPA=0 I '$D(GMRALL) W !,"No CAUSATIVE AGENTS have been selected for this patient."
|
|
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)
|
|
K GMRAPA
|
|
D HANGT^GMRAPEH0
|
|
HLP1 ;LIST ALL ALLERGIES
|
|
W !,"You may choose CAUSATIVE AGENTS from the following list for this patient:"
|
|
N DIC
|
|
I '$D(^GMR(120.8,"B",DFN)) W !?4,"There are no reactions on file for this patient." Q
|
|
D HLP12085^GMRAU851(DFN,"'+$G(^GMR(120.8,+GMRAX,""ER""))")
|
|
D HANGT^GMRAPEH0
|
|
Q
|