GMRAFDA3 ;HIRMFO/WAA-DISPLAY FDA REPORT OVER DT RANGE ;12/1/95 11:34
;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
EN1 ; Entry for PRINT ALL FDA EVENTS WITHIN D/T RANGE option
S GMRAOUT=0 K DIR
S DIR(0)="DO^:NOW:EXT",DIR("A")="Select Start Date/Time"
D ^DIR K DIR
I $D(DIRUT) G EXIT
S GMRABGDT=Y K Y
S DIR(0)="DO^"_GMRABGDT_":NOW:EXT",DIR("A")="Select End Date/Time",DIR("B")="T"
D ^DIR K DIR
I $D(DIRUT) G EXIT
S GMRAENDT=Y K Y
EN2 ;
S GMRABGDT=GMRABGDT-.0000001
S GMRAENDT=$S($P(GMRAENDT,".",2)="":GMRAENDT_".24",1:(GMRAENDT+.000001))
YN F S %=1 W !,"Do you want an Abbreviated report" D YN^DICN S:%=-1 %=2,GMRAOUT=1 Q:% W !,"ENTER ""Y"" FOR YES OR ""N"" FOR NO",$C(7)
G:GMRAOUT EXIT
S GMRAYN=%
PRINTER ;Select printer
S GMRAOUT=0,GMRAPG=0
W ! K GMRAZIS S:GMRAYN=2 GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" G EXIT
I $D(IO("Q")) D G EXIT
.S ZTRTN="PRINT^GMRAFDA3",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("GMRABGDT")="",ZTSAVE("GMRAENDT")="",ZTSAVE("GMRAYN")=""
.S ZTDESC="Print FDA Report by Date/Time" D ^%ZTLOAD
.W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
.Q
U IO D PRINT U IO(0)
D CLOSE^GMRAUTL
G EXIT
Q
PRINT ;Central Print
N GMRACNT S GMRACNT=0
S GMRAFLG=0,GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"1")
I IOST?1"C".E W @IOF
I GMRAYN=1 D HDR1
F S GMRABGDT=$O(^GMR(120.85,"B",GMRABGDT)) Q:GMRABGDT<1!(GMRABGDT>GMRAENDT)!(GMRAOUT) S GMRAPA1=0 F S GMRAPA1=$O(^GMR(120.85,"B",GMRABGDT,GMRAPA1)) Q:GMRAPA1<1 D Q:GMRAOUT
.I +$P($G(^GMR(120.8,+$P($G(^GMR(120.85,+GMRAPA1,0)),U,15),"ER")),U,1)=1 Q
.I GMRAYN=2 D PRT^GMRAFDA1 Q
.I $Y>(IOSL-3) D HEAD Q:GMRAOUT
.S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""
.S GMRAPA(0)=$G(^GMR(120.8,$P(GMRAPA1(0),U,15),0)) Q:GMRAPA(0)=""
.S DFN=$P(GMRAPA(0),U) D PID^VADPT6
.Q:'$$PRDTST^GMRAUTL1(DFN) ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
.S GMRACNT=GMRACNT+1
.W !,$E($P(^DPT(DFN,0),U),1,23)," (",VA("PID"),")" K VA,DFN
.W ?32,$E($P(GMRAPA(0),U,2),1,28)
.W ?62 S Y=$P(GMRAPA1(0),U),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2) K Y
.I $P($G(^GMR(120.85,GMRAPA1,"PTC1")),U,5) D
..W !,?5,"(SENT TO FDA: " S Y=$P(^GMR(120.85,GMRAPA1,"PTC1"),U,5),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2),")" K Y
.Q
.K GMRAPA1(0),GMRAPA(0)
.Q
I 'GMRACNT W !,?30,"NO DATA FOR THIS REPORT"
Q
HEAD ;Header Print
HDR ;
I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q
W @IOF
HDR1 S GMRAPG=GMRAPG+1
W GMRANOW,?70,"Page: ",GMRAPG
W !,?30,"FDA ABBREVIATED REPORT"
W !,"PATIENT",?32,"SUSPECTED AGENT",?62,"D/T OF EVENT"
W !,$$REPEAT^XLFSTR("-",79),!
Q
EXIT ;EXIT
K ^TMP($J,"GMRAEF")
D KILL^XUSCLEAN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAFDA3 2786 printed Dec 13, 2024@01:39:08 Page 2
GMRAFDA3 ;HIRMFO/WAA-DISPLAY FDA REPORT OVER DT RANGE ;12/1/95 11:34
+1 ;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
EN1 ; Entry for PRINT ALL FDA EVENTS WITHIN D/T RANGE option
+1 SET GMRAOUT=0
KILL DIR
+2 SET DIR(0)="DO^:NOW:EXT"
SET DIR("A")="Select Start Date/Time"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO EXIT
+5 SET GMRABGDT=Y
KILL Y
+6 SET DIR(0)="DO^"_GMRABGDT_":NOW:EXT"
SET DIR("A")="Select End Date/Time"
SET DIR("B")="T"
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO EXIT
+9 SET GMRAENDT=Y
KILL Y
EN2 ;
+1 SET GMRABGDT=GMRABGDT-.0000001
+2 SET GMRAENDT=$SELECT($PIECE(GMRAENDT,".",2)="":GMRAENDT_".24",1:(GMRAENDT+.000001))
YN FOR
SET %=1
WRITE !,"Do you want an Abbreviated report"
DO YN^DICN
if %=-1
SET %=2
SET GMRAOUT=1
if %
QUIT
WRITE !,"ENTER ""Y"" FOR YES OR ""N"" FOR NO",$CHAR(7)
+1 if GMRAOUT
GOTO EXIT
+2 SET GMRAYN=%
PRINTER ;Select printer
+1 SET GMRAOUT=0
SET GMRAPG=0
+2 WRITE !
KILL GMRAZIS
if GMRAYN=2
SET GMRAZIS="QM132S60"
DO DEV^GMRAUTL
IF POP
WRITE !,"PLEASE TRY LATER"
GOTO EXIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="PRINT^GMRAFDA3"
SET ZTSAVE("GMRAPG")=""
SET ZTSAVE("GMRAOUT")=""
SET ZTSAVE("GMRABGDT")=""
SET ZTSAVE("GMRAENDT")=""
SET ZTSAVE("GMRAYN")=""
+5 SET ZTDESC="Print FDA Report by Date/Time"
DO ^%ZTLOAD
+6 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
+7 QUIT
End DoDot:1
GOTO EXIT
+8 USE IO
DO PRINT
USE IO(0)
+9 DO CLOSE^GMRAUTL
+10 GOTO EXIT
+11 QUIT
PRINT ;Central Print
+1 NEW GMRACNT
SET GMRACNT=0
+2 SET GMRAFLG=0
SET GMRANOW=$$NOW^XLFDT
SET GMRANOW=$$FMTE^XLFDT(GMRANOW,"1")
+3 IF IOST?1"C".E
WRITE @IOF
+4 IF GMRAYN=1
DO HDR1
+5 FOR
SET GMRABGDT=$ORDER(^GMR(120.85,"B",GMRABGDT))
if GMRABGDT<1!(GMRABGDT>GMRAENDT)!(GMRAOUT)
QUIT
SET GMRAPA1=0
FOR
SET GMRAPA1=$ORDER(^GMR(120.85,"B",GMRABGDT,GMRAPA1))
if GMRAPA1<1
QUIT
Begin DoDot:1
+6 IF +$PIECE($GET(^GMR(120.8,+$PIECE($GET(^GMR(120.85,+GMRAPA1,0)),U,15),"ER")),U,1)=1
QUIT
+7 IF GMRAYN=2
DO PRT^GMRAFDA1
QUIT
+8 IF $Y>(IOSL-3)
DO HEAD
if GMRAOUT
QUIT
+9 SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))
if GMRAPA1(0)=""
QUIT
+10 SET GMRAPA(0)=$GET(^GMR(120.8,$PIECE(GMRAPA1(0),U,15),0))
if GMRAPA(0)=""
QUIT
+11 SET DFN=$PIECE(GMRAPA(0),U)
DO PID^VADPT6
+12 ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
if '$$PRDTST^GMRAUTL1(DFN)
QUIT
+13 SET GMRACNT=GMRACNT+1
+14 WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,23)," (",VA("PID"),")"
KILL VA,DFN
+15 WRITE ?32,$EXTRACT($PIECE(GMRAPA(0),U,2),1,28)
+16 WRITE ?62
SET Y=$PIECE(GMRAPA1(0),U)
SET Y=$$DATE^GMRAUTL1(Y)
WRITE $PIECE(Y,":",1,2)
KILL Y
+17 IF $PIECE($GET(^GMR(120.85,GMRAPA1,"PTC1")),U,5)
Begin DoDot:2
+18 WRITE !,?5,"(SENT TO FDA: "
SET Y=$PIECE(^GMR(120.85,GMRAPA1,"PTC1"),U,5)
SET Y=$$DATE^GMRAUTL1(Y)
WRITE $PIECE(Y,":",1,2),")"
KILL Y
End DoDot:2
+19 QUIT
+20 KILL GMRAPA1(0),GMRAPA(0)
+21 QUIT
End DoDot:1
if GMRAOUT
QUIT
+22 IF 'GMRACNT
WRITE !,?30,"NO DATA FOR THIS REPORT"
+23 QUIT
HEAD ;Header Print
HDR ;
+1 IF IOST?1"C".E
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y'>0
SET GMRAOUT=1
QUIT
+2 WRITE @IOF
HDR1 SET GMRAPG=GMRAPG+1
+1 WRITE GMRANOW,?70,"Page: ",GMRAPG
+2 WRITE !,?30,"FDA ABBREVIATED REPORT"
+3 WRITE !,"PATIENT",?32,"SUSPECTED AGENT",?62,"D/T OF EVENT"
+4 WRITE !,$$REPEAT^XLFSTR("-",79),!
+5 QUIT
EXIT ;EXIT
+1 KILL ^TMP($JOB,"GMRAEF")
+2 DO KILL^XUSCLEAN
+3 QUIT
