GMRAEF2 ;HIRMFO/WAA-FDA EXCEPTION REPORT ;11/29/95 15:01
;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
EN1 ; Entry to PRINT ALL FDA EXCEPTIONS WITHIN A D/T RANGE option
S GMRAOUT=0 K DIR
S DIR(0)="DO^:DT:ETX",DIR("A")="Select Start Date"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT
S (GMRABGDT,GMRASTDT)=Y K Y
S DIR(0)="DO^"_GMRABGDT_":NOW:ETX",DIR("A")="Select End Date",DIR("B")="T"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT
S GMRAEDT=Y,GMRAENDT=((Y+1)-.0000001) K Y
EN2 ;
S GMRABGDT=GMRABGDT-.0000001
F S GMRABGDT=$O(^GMR(120.8,"AODT",GMRABGDT)) Q:GMRABGDT<1 Q:GMRABGDT>GMRAENDT S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,"AODT",GMRABGDT,GMRAIEN)) Q:GMRAIEN<1 D
.S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0))
.Q:$P(GMRA(0),U,2)=""
.Q:$D(^GMR(120.8,GMRAIEN,"ER"))
.I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q
.I '$P(GMRA(0),U,12) Q
.I $$CMPFDA^GMRAEF1(GMRAIEN) Q
.S GMRDFN=$P(GMRA(0),U)
.Q:'$$PRDTST^GMRAUTL1(GMRDFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
.S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
.Q
D EN1^GMRAEF
EXIT ;EXIT OF ROUTINE
K GMRAY,GMRAX,GMRAIEN,GMRDFN,GMRBGDT,GMRENDT,GMRDT,GMRAOUT
K GMRA,GMRABGDT,GMRAENDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAEF2 1312 printed Nov 22, 2024@16:49:16 Page 2
GMRAEF2 ;HIRMFO/WAA-FDA EXCEPTION REPORT ;11/29/95 15:01
+1 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
EN1 ; Entry to PRINT ALL FDA EXCEPTIONS WITHIN A D/T RANGE option
+1 SET GMRAOUT=0
KILL DIR
+2 SET DIR(0)="DO^:DT:ETX"
SET DIR("A")="Select Start Date"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
SET GMRAOUT=1
GOTO EXIT
+5 SET (GMRABGDT,GMRASTDT)=Y
KILL Y
+6 SET DIR(0)="DO^"_GMRABGDT_":NOW:ETX"
SET DIR("A")="Select End Date"
SET DIR("B")="T"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
SET GMRAOUT=1
GOTO EXIT
+9 SET GMRAEDT=Y
SET GMRAENDT=((Y+1)-.0000001)
KILL Y
EN2 ;
+1 SET GMRABGDT=GMRABGDT-.0000001
+2 FOR
SET GMRABGDT=$ORDER(^GMR(120.8,"AODT",GMRABGDT))
if GMRABGDT<1
QUIT
if GMRABGDT>GMRAENDT
QUIT
SET GMRAIEN=0
FOR
SET GMRAIEN=$ORDER(^GMR(120.8,"AODT",GMRABGDT,GMRAIEN))
if GMRAIEN<1
QUIT
Begin DoDot:1
+3 SET GMRA(0)=$GET(^GMR(120.8,GMRAIEN,0))
+4 if $PIECE(GMRA(0),U,2)=""
QUIT
+5 if $DATA(^GMR(120.8,GMRAIEN,"ER"))
QUIT
+6 IF $PIECE(GMRA(0),U,6)'="o"!($PIECE(GMRA(0),U,20)'["D")
QUIT
+7 IF '$PIECE(GMRA(0),U,12)
QUIT
+8 IF $$CMPFDA^GMRAEF1(GMRAIEN)
QUIT
+9 SET GMRDFN=$PIECE(GMRA(0),U)
+10 ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
if '$$PRDTST^GMRAUTL1(GMRDFN)
QUIT
+11 SET ^TMP($JOB,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
+12 QUIT
End DoDot:1
+13 DO EN1^GMRAEF
EXIT ;EXIT OF ROUTINE
+1 KILL GMRAY,GMRAX,GMRAIEN,GMRDFN,GMRBGDT,GMRENDT,GMRDT,GMRAOUT
+2 KILL GMRA,GMRABGDT,GMRAENDT
+3 QUIT
