- 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 Mar 13, 2025@20:43:48 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
