GMRADGMV ;HIRMFO/RM-ALLERGY PT. MOVEMENT EVENTS ; 7/24/91
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; CALLED FROM GMRADGPM MARK CHART PROTOCOL
Q:DGPMP'=""!($P(DGPMA,"^",2)'=1)!'$O(^GMR(120.8,"B",DFN,0))
S ZTDTH=$H,ZTDESC="Fire Bulletin to Mark Patient Allergy DFN="_DFN,ZTRTN="EN2^GMRADGMV",ZTIO="",ZTSAVE("DFN")="",ZTSAVE("DGPMA")="" D ^%ZTLOAD K ZTSK
Q
EN2 ; FIRE BULLETINS FOR ACTIVE PATIENT ALLERGIES
S GMRANAM=$P($G(^DPT(DFN,0)),"^"),GMRALOC=$P($G(^(.1)),"^"),GMRAMOV=+$G(^(.102)),GMRAWLOC=$P($G(^DGPM(+GMRAMOV,0)),"^",6),GMRAHLOC=+$G(^DIC(42,+GMRAWLOC,44)) G:'GMRAHLOC Q2
D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
S (GMRAPA,GMRAPA2)=0 F S GMRAPA=$O(^GMR(120.8,"B",DFN,GMRAPA)) Q:GMRAPA'>0 D
.S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
.I $P(GMRAPA(0),"^",12),'+$G(^GMR(120.8,GMRAPA,"ER")),'$O(^GMR(120.8,GMRAPA,13,"B",+DGPMA-.0001)) D
..S GMRAPA2=GMRAPA2+1,GMRAPA2(GMRAPA2)=$P(GMRAPA(0),U,2)
..S GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_U_$S($P(GMRAPA(0),U,14)="A":"Allergy",$P(GMRAPA(0),U,14)="P":"Adverse Reaction",$P(GMRAPA(0),U,14)="U":"Unknown",1:"")
..Q
.Q
;This routine is to send one message with all of the patient's allergies
D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0))
I GMRAPA2,$P(GMRASITE(0),U,10) D BULLT^GMRASEN2
Q2 K DFN,DGPMA,GMRAHLOC,GMRALOC,GMRAMOV,GMRANAM,GMRAPA,GMRAPA2,GMRAWLOC,GMRASITE S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRADGMV 1387 printed Dec 13, 2024@01:38:49 Page 2
GMRADGMV ;HIRMFO/RM-ALLERGY PT. MOVEMENT EVENTS ; 7/24/91
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; CALLED FROM GMRADGPM MARK CHART PROTOCOL
+1 if DGPMP'=""!($PIECE(DGPMA,"^",2)'=1)!'$ORDER(^GMR(120.8,"B",DFN,0))
QUIT
+2 SET ZTDTH=$HOROLOG
SET ZTDESC="Fire Bulletin to Mark Patient Allergy DFN="_DFN
SET ZTRTN="EN2^GMRADGMV"
SET ZTIO=""
SET ZTSAVE("DFN")=""
SET ZTSAVE("DGPMA")=""
DO ^%ZTLOAD
KILL ZTSK
+3 QUIT
EN2 ; FIRE BULLETINS FOR ACTIVE PATIENT ALLERGIES
+1 SET GMRANAM=$PIECE($GET(^DPT(DFN,0)),"^")
SET GMRALOC=$PIECE($GET(^(.1)),"^")
SET GMRAMOV=+$GET(^(.102))
SET GMRAWLOC=$PIECE($GET(^DGPM(+GMRAMOV,0)),"^",6)
SET GMRAHLOC=+$GET(^DIC(42,+GMRAWLOC,44))
if 'GMRAHLOC
GOTO Q2
+2 DO PID^VADPT6
SET GMRAVIP=VA("PID")
DO KVAR^VADPT
KILL VA
+3 SET (GMRAPA,GMRAPA2)=0
FOR
SET GMRAPA=$ORDER(^GMR(120.8,"B",DFN,GMRAPA))
if GMRAPA'>0
QUIT
Begin DoDot:1
+4 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
+5 IF $PIECE(GMRAPA(0),"^",12)
IF '+$GET(^GMR(120.8,GMRAPA,"ER"))
IF '$ORDER(^GMR(120.8,GMRAPA,13,"B",+DGPMA-.0001))
Begin DoDot:2
+6 SET GMRAPA2=GMRAPA2+1
SET GMRAPA2(GMRAPA2)=$PIECE(GMRAPA(0),U,2)
+7 SET GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_U_$SELECT($PIECE(GMRAPA(0),U,14)="A":"Allergy",$PIECE(GMRAPA(0),U,14)="P":"Adverse Reaction",$PIECE(GMRAPA(0),U,14)="U":"Unknown",1:"")
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 ;This routine is to send one message with all of the patient's allergies
+11 DO SITE^GMRAUTL
SET GMRASITE(0)=$GET(^GMRD(120.84,GMRASITE,0))
+12 IF GMRAPA2
IF $PIECE(GMRASITE(0),U,10)
DO BULLT^GMRASEN2
Q2 KILL DFN,DGPMA,GMRAHLOC,GMRALOC,GMRAMOV,GMRANAM,GMRAPA,GMRAPA2,GMRAWLOC,GMRASITE
SET ZTREQ="@"
+1 QUIT
