GMRAMCB ;HIRMFO/WAA - MARK CHART & ID BAND FIELD EDIT ;5/29/18 7:34am
;;4.0;Adverse Reaction Tracking;**21,36,59**;Mar 29, 1996;Build 3
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
..;GMRA*4.0*59 - only change: comment line immediately below
..;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAMCB 2973 printed Oct 16, 2024@17:40:23 Page 2
GMRAMCB ;HIRMFO/WAA - MARK CHART & ID BAND FIELD EDIT ;5/29/18 7:34am
+1 ;;4.0;Adverse Reaction Tracking;**21,36,59**;Mar 29, 1996;Build 3
EN3 ;Entry for EDIT CHART & ID BAND option
+1 KILL GMRALL
SET GMRAOUT=0
DO GETAL^GMRAMCB1
IF GMRAOUT!'$DATA(GMRALL)
if DFN>0
LOCK -^GMR(120.8,"B",DFN)
GOTO Q3
+2 DO EN5
if 'GMRAOUT
DO EN7
+3 LOCK -^GMR(120.8,"B",DFN)
+4 GOTO Q3
EN4(GMRALL,DFN) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT
+1 DO EN5
if 'GMRAOUT
DO EN7
QUIT
EN5 ;THIS IS THE ENTRY POINT TO BY PASS THE FORMAL LIST AGAIN
+1 DO VAD^GMRAUTL1(DFN,"",.GMRALOC,.GMRANAM,"",.GMRASSN)
+2 ;36
NEW REQ
SET REQ=0
SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(GMRALL(GMRAPA))
if '+GMRAPA!(REQ)
QUIT
if '$ORDER(^GMR(120.8,GMRAPA,14,0))
SET REQ=1
+3 SET GMRATYPE="B"
SET I=0
SET GMRAPA=0
WRITE !,"This session you have CHOSEN:"
FOR
SET GMRAPA=$ORDER(GMRALL(GMRAPA))
if GMRAPA<1
QUIT
SET I=I+1
WRITE !,?5,$PIECE($GET(^GMR(120.8,GMRAPA,0)),U,2)
+4 WRITE !
DO SITE^GMRAUTL
SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))
SET GMRAOUT=0
+5 FOR GMRAMARK="13^Chart(s)","14^ID Band"
SET GMRAM2=$PIECE(GMRAMARK,"^",2)
SET GMRAM1=$PIECE(GMRAMARK,"^")
Begin DoDot:1
+6 ;36
IF GMRAM1=14
IF ($PIECE(GMRASITE(0),U,5)=0!(GMRALOC=""))!('REQ)
QUIT
+7 SET GMRANULL=0
FOR
SET %=0
Begin DoDot:2
+8 ;GMRA*4.0*59 - only change: comment line immediately below
+9 ;I GMRAM1=13 S %=1,%Y="Y" Q ;21 Marked on chart set to YES automatically
+10 WRITE !,$SELECT(GMRAM1=14:"Has",1:"Have")," the "_GMRAM2_" been marked for",$SELECT(I>1:" these CAUSATIVE AGENTS",1:" this CAUSATIVE AGENT")
DO YN^DICN
+11 if %Y=""
QUIT
+12 if %<0
SET %=2
SET GMRAOUT=1
if %
QUIT
WRITE !?4,"ANSWER YES IF THE "_GMRAM2_" HAS BEEN MARKED, ELSE ANSWER NO."
+13 QUIT
End DoDot:2
IF %!(%Y="")
QUIT
+14 IF %=2!(%Y="")
QUIT
+15 SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(GMRALL(GMRAPA))
if GMRAPA<1
QUIT
Begin DoDot:2
+16 IF '$DATA(^GMR(120.8,GMRAPA,GMRAM1,0))
SET ^(0)="^120.8"_GMRAM1_"DA^^"
+17 DO NOW^%DTC
KILL DO,DD,DINUM
SET X=%
SET DIC="^GMR(120.8,"_GMRAPA_","_GMRAM1_","
SET DIC(0)="L"
SET DLAYGO=120.8
SET DA(1)=GMRAPA
SET DIC("DR")="1////"_DUZ
DO FILE^DICN
KILL DIC,DLAYGO
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
if GMRAOUT
QUIT
+20 QUIT
EN6(GMRALL,DFN,GMRATYPE) ;THIS IS THE ENTRY POINT IF YOU KNOW THE ALLERGIES AND PATIENT
+1 NEW GMRAOUT,%,%Y
SET GMRAOUT=0
+2 DO SITE^GMRAUTL
SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))
EN7 IF $DATA(%Y)
IF %Y=""
QUIT
+1 SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(GMRALL(GMRAPA))
if GMRAPA<1
QUIT
Begin DoDot:1
+2 IF $ORDER(^GMR(120.8,GMRAPA,13,0))&($PIECE(GMRASITE(0),U,5)=0!$ORDER(^GMR(120.8,GMRAPA,14,0))!(GMRALOC=""))
QUIT
+3 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
DO BULLT^GMRASEND
+4 QUIT
End DoDot:1
+5 QUIT
Q3 ; CLEAN UP AFTER EN3
+1 DO KILL^XUSCLEAN
+2 QUIT
HELP ;THIS ROUTINE WILL LIST ALL THE SELECTED ALLERGIES AND ALL THE
+1 ;CURRENT SELECTED ALLERGIES
+2 SET GMRAPA=0
IF '$DATA(GMRALL)
WRITE !,"No CAUSATIVE AGENTS have been selected for this patient."
+3 IF '$TEST
WRITE !,"You have selected the following CAUSATIVE AGENTS:",!
SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(GMRALL(GMRAPA))
if GMRAPA<1
QUIT
WRITE !,?5,$PIECE($GET(^GMR(120.8,GMRAPA,0)),U,2)
+4 KILL GMRAPA
+5 DO HANGT^GMRAPEH0
HLP1 ;LIST ALL ALLERGIES
+1 WRITE !,"You may choose CAUSATIVE AGENTS from the following list for this patient:"
+2 NEW DIC
+3 IF '$DATA(^GMR(120.8,"B",DFN))
WRITE !?4,"There are no reactions on file for this patient."
QUIT
+4 DO HLP12085^GMRAU851(DFN,"'+$G(^GMR(120.8,+GMRAX,""ER""))")
+5 DO HANGT^GMRAPEH0
+6 QUIT
