GMRAFDA1 ;HIRMFO/WAA-SELECT PATIENT AND PRINTER FOR REPORTS PRINT OUT ;12/1/95 11:23
;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
EN1 ;Entry to PRINT AN FDA REPORT FOR A PATIENT option
S GMRAOUT=0,GMRALAGO=0 D EN1^GMRAU85 G:GMRAPA1'>0 EXIT
S GMRANAM=$P($G(^DPT($P(GMRAPA(0),U),0)),U)
D DEV1
D EXIT
Q
DEV1 W !,"THIS REPORT SHOULD BE SENT TO A 132 COLUMN PRINTER.",!
S GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY AGAIN LATER" S GMRAOUT=1 Q
I $D(IO("Q")) D Q
.S ZTSAVE("GMRAPA1")="",ZTRTN="PRINT^GMRAFDA1",ZTDESC="Produce FDA Report for "_GMRANAM
.D ^%ZTLOAD K IO("Q")
.W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
.Q
D PRINT Q
Q
PRINT ; ENTRY POINT TO BEGIN PRINTING THIS REPORT
U IO D PRT U IO(0)
D CLOSE^GMRAUTL
Q
PRT D ^GMRAFN1
I $D(^TMP($J,"GMR")) D PRINT2 W @IOF
Q
PRINT2 ;PRINT THE SECOND PAGE OF ANY REMAINING DATA
D ;HEADER INFORMATION
.N GMRASUS,GMRATAB
.W !,"ATTACHMENT PAGE"
.W !,"PATIENT ID: ",GMRAID
.S GMRASUS=$P(GMRAPA1(0),U,15)
.I GMRASUS>0 S GMRATAB=66-((20+$L($P($G(^GMR(120.8,GMRASUS,0)),U,2)))/2) W ?GMRATAB,"SUSPECT MEDICATION: ",$P($G(^GMR(120.8,GMRASUS,0)),U,2)
.W ?100,"DATE OF EVENT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U),2)
.Q
I $D(^TMP($J,"GMR","R")) D
.W ! F I=1:1:132 W "-"
.W !,"Section B. Part 5. Describe event Continued" S GMRAX=0
.S DIWL=5,DIWR=128,DIWF="" K ^UTILITY($J,"W",5) S GMRAX=0 ;D K ^UTILITY($J,"W",5)
.F S GMRAX=$O(^TMP($J,"GMR","R",GMRAX)) Q:GMRAX<1 S X=^TMP($J,"GMR","R",GMRAX) D ^DIWP
.K ^TMP($J,"GMR","R")
.S X=0 F S X=$O(^UTILITY($J,"W",5,X)) Q:X<1 S ^TMP($J,"GMR","R",X)=$G(^UTILITY($J,"W",5,X,0))
.F S GMRAX=$O(^TMP($J,"GMR","R",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
..W !,$S($D(^TMP($J,"GMR","R",GMRAX+1)):^TMP($J,"GMR","R",GMRAX),1:$E(^TMP($J,"GMR","R",GMRAX),1,($L(^TMP($J,"GMR","R",GMRAX))-2)))
..Q
.Q
I $D(^TMP($J,"GMR","T")) D
.W ! F I=1:1:132 W "-"
.W !,"Section B. Part 6. Relevant Test/Laboratory Data Continued:"
.S GMRAX=0 F S GMRAX=$O(^TMP($J,"GMR","T",GMRAX)) Q:GMRAX'>0 D Q:GMRAOUT
..W !,"TEST: ",$P(^TMP($J,"GMR","T",GMRAX),U)," RESULTS: ",$P(^(GMRAX),U,2) S Y=$P(^(GMRAX),U,3) W:Y'="" " COLLECTION DATE: ",$$FMTE^XLFDT(Y,"2") K Y
..Q
.Q
I $D(^TMP($J,"GMR","O")) D
.S DIWL=5,DIWR=128,DIWF="" K ^UTILITY($J,"W",5) S GMRAX=0 ;D K ^UTILITY($J,"W",5)
.F S GMRAX=$O(^TMP($J,"GMR","O",GMRAX)) Q:GMRAX<1 S X=^TMP($J,"GMR","O",GMRAX) D ^DIWP
.K ^TMP($J,"GMR","O")
.S X=0 F S X=$O(^UTILITY($J,"W",5,X)) Q:X<1 S ^TMP($J,"GMR","O",X)=$G(^UTILITY($J,"W",5,X,0))
.W ! F I=1:1:132 W "-"
.W !,"Section B. Part 7. Other Relevant History Continued" S GMRAX=0
.F S GMRAX=$O(^TMP($J,"GMR","O",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
..W !,^TMP($J,"GMR","O",GMRAX)
..Q
.Q
I $D(^TMP($J,"GMR","C")) D
.W ! F I=1:1:132 W "-"
.W !,"Section C. Part 10. Concomitant Drugs Continued" S GMRAX=0
.F S GMRAX=$O(^TMP($J,"GMR","C",GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
..W !,$P(^TMP($J,"GMR","C",GMRAX),"^"),?60 S X=$P(^(GMRAX),"^",2) W:X]"" $E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) S X=$P(^(GMRAX),"^",3) W:X]"" "-",$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
..Q
.Q
Q
EXIT ;
K ^TMP($J,"GMR")
D KILL^XUSCLEAN
Q
LKP ; ADDITIONAL LOOKUP ON 120.85
N GMRA S GMRA=$G(^GMR(120.85,+Y,0))
I $P(GMRA,U)'="" W " ",$$FMTE^XLFDT($P(^GMR(120.85,+Y,0),U),"2S")
I $P(GMRA,U,15)'="" W " ",$P($G(^GMR(120.8,$P(GMRA,U,15),0)),U,2)
W $E(@(DIC_+Y_",0)"),0)
Q
SET ; set up variables for question mark help
S X=GMRANAM,DLAYGO=120.85,DIC="^GMR(120.85,",DIC(0)="E",D="D",DIC("W")="D LKP^GMRAFDA1",DZ="??"
S DIC("S")="I $P(^(0),U,2)=DFN S GMRA1208=+$P(^(0),U,15) I $$ERCHK^GMRAFDA1"
Q
ERCHK() ; check for "ER" node to screen out entered-in-error entries
I '$D(^GMR(120.8,+GMRA1208,0)) Q 1
I '$D(^GMR(120.8,+GMRA1208,"ER")) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAFDA1 3848 printed Oct 16, 2024@17:39:58 Page 2
GMRAFDA1 ;HIRMFO/WAA-SELECT PATIENT AND PRINTER FOR REPORTS PRINT OUT ;12/1/95 11:23
+1 ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
EN1 ;Entry to PRINT AN FDA REPORT FOR A PATIENT option
+1 SET GMRAOUT=0
SET GMRALAGO=0
DO EN1^GMRAU85
if GMRAPA1'>0
GOTO EXIT
+2 SET GMRANAM=$PIECE($GET(^DPT($PIECE(GMRAPA(0),U),0)),U)
+3 DO DEV1
+4 DO EXIT
+5 QUIT
DEV1 WRITE !,"THIS REPORT SHOULD BE SENT TO A 132 COLUMN PRINTER.",!
+1 SET GMRAZIS="QM132S60"
DO DEV^GMRAUTL
IF POP
WRITE !,"PLEASE TRY AGAIN LATER"
SET GMRAOUT=1
QUIT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTSAVE("GMRAPA1")=""
SET ZTRTN="PRINT^GMRAFDA1"
SET ZTDESC="Produce FDA Report for "_GMRANAM
+4 DO ^%ZTLOAD
KILL IO("Q")
+5 WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
+6 QUIT
End DoDot:1
QUIT
+7 DO PRINT
QUIT
+8 QUIT
PRINT ; ENTRY POINT TO BEGIN PRINTING THIS REPORT
+1 USE IO
DO PRT
USE IO(0)
+2 DO CLOSE^GMRAUTL
+3 QUIT
PRT DO ^GMRAFN1
+1 IF $DATA(^TMP($JOB,"GMR"))
DO PRINT2
WRITE @IOF
+2 QUIT
PRINT2 ;PRINT THE SECOND PAGE OF ANY REMAINING DATA
+1 ;HEADER INFORMATION
Begin DoDot:1
+2 NEW GMRASUS,GMRATAB
+3 WRITE !,"ATTACHMENT PAGE"
+4 WRITE !,"PATIENT ID: ",GMRAID
+5 SET GMRASUS=$PIECE(GMRAPA1(0),U,15)
+6 IF GMRASUS>0
SET GMRATAB=66-((20+$LENGTH($PIECE($GET(^GMR(120.8,GMRASUS,0)),U,2)))/2)
WRITE ?GMRATAB,"SUSPECT MEDICATION: ",$PIECE($GET(^GMR(120.8,GMRASUS,0)),U,2)
+7 WRITE ?100,"DATE OF EVENT: ",$$FMTE^XLFDT($PIECE(GMRAPA1(0),U),2)
+8 QUIT
End DoDot:1
+9 IF $DATA(^TMP($JOB,"GMR","R"))
Begin DoDot:1
+10 WRITE !
FOR I=1:1:132
WRITE "-"
+11 WRITE !,"Section B. Part 5. Describe event Continued"
SET GMRAX=0
+12 ;D K ^UTILITY($J,"W",5)
SET DIWL=5
SET DIWR=128
SET DIWF=""
KILL ^UTILITY($JOB,"W",5)
SET GMRAX=0
+13 FOR
SET GMRAX=$ORDER(^TMP($JOB,"GMR","R",GMRAX))
if GMRAX<1
QUIT
SET X=^TMP($JOB,"GMR","R",GMRAX)
DO ^DIWP
+14 KILL ^TMP($JOB,"GMR","R")
+15 SET X=0
FOR
SET X=$ORDER(^UTILITY($JOB,"W",5,X))
if X<1
QUIT
SET ^TMP($JOB,"GMR","R",X)=$GET(^UTILITY($JOB,"W",5,X,0))
+16 FOR
SET GMRAX=$ORDER(^TMP($JOB,"GMR","R",GMRAX))
if GMRAX<1
QUIT
Begin DoDot:2
+17 WRITE !,$SELECT($DATA(^TMP($JOB,"GMR","R",GMRAX+1)):^TMP($JOB,"GMR","R",GMRAX),1:$EXTRACT(^TMP($JOB,"GMR","R",GMRAX),1,($LENGTH(^TMP($JOB,"GMR","R",GMRAX))-2)))
+18 QUIT
End DoDot:2
if GMRAOUT
QUIT
+19 QUIT
End DoDot:1
+20 IF $DATA(^TMP($JOB,"GMR","T"))
Begin DoDot:1
+21 WRITE !
FOR I=1:1:132
WRITE "-"
+22 WRITE !,"Section B. Part 6. Relevant Test/Laboratory Data Continued:"
+23 SET GMRAX=0
FOR
SET GMRAX=$ORDER(^TMP($JOB,"GMR","T",GMRAX))
if GMRAX'>0
QUIT
Begin DoDot:2
+24 WRITE !,"TEST: ",$PIECE(^TMP($JOB,"GMR","T",GMRAX),U)," RESULTS: ",$PIECE(^(GMRAX),U,2)
SET Y=$PIECE(^(GMRAX),U,3)
if Y'=""
WRITE " COLLECTION DATE: ",$$FMTE^XLFDT(Y,"2")
KILL Y
+25 QUIT
End DoDot:2
if GMRAOUT
QUIT
+26 QUIT
End DoDot:1
+27 IF $DATA(^TMP($JOB,"GMR","O"))
Begin DoDot:1
+28 ;D K ^UTILITY($J,"W",5)
SET DIWL=5
SET DIWR=128
SET DIWF=""
KILL ^UTILITY($JOB,"W",5)
SET GMRAX=0
+29 FOR
SET GMRAX=$ORDER(^TMP($JOB,"GMR","O",GMRAX))
if GMRAX<1
QUIT
SET X=^TMP($JOB,"GMR","O",GMRAX)
DO ^DIWP
+30 KILL ^TMP($JOB,"GMR","O")
+31 SET X=0
FOR
SET X=$ORDER(^UTILITY($JOB,"W",5,X))
if X<1
QUIT
SET ^TMP($JOB,"GMR","O",X)=$GET(^UTILITY($JOB,"W",5,X,0))
+32 WRITE !
FOR I=1:1:132
WRITE "-"
+33 WRITE !,"Section B. Part 7. Other Relevant History Continued"
SET GMRAX=0
+34 FOR
SET GMRAX=$ORDER(^TMP($JOB,"GMR","O",GMRAX))
if GMRAX<1
QUIT
Begin DoDot:2
+35 WRITE !,^TMP($JOB,"GMR","O",GMRAX)
+36 QUIT
End DoDot:2
if GMRAOUT
QUIT
+37 QUIT
End DoDot:1
+38 IF $DATA(^TMP($JOB,"GMR","C"))
Begin DoDot:1
+39 WRITE !
FOR I=1:1:132
WRITE "-"
+40 WRITE !,"Section C. Part 10. Concomitant Drugs Continued"
SET GMRAX=0
+41 FOR
SET GMRAX=$ORDER(^TMP($JOB,"GMR","C",GMRAX))
if GMRAX<1
QUIT
Begin DoDot:2
+42 WRITE !,$PIECE(^TMP($JOB,"GMR","C",GMRAX),"^"),?60
SET X=$PIECE(^(GMRAX),"^",2)
if X]""
WRITE $EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
SET X=$PIECE(^(GMRAX),"^",3)
if X]""
WRITE "-",$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
+43 QUIT
End DoDot:2
if GMRAOUT
QUIT
+44 QUIT
End DoDot:1
+45 QUIT
EXIT ;
+1 KILL ^TMP($JOB,"GMR")
+2 DO KILL^XUSCLEAN
+3 QUIT
LKP ; ADDITIONAL LOOKUP ON 120.85
+1 NEW GMRA
SET GMRA=$GET(^GMR(120.85,+Y,0))
+2 IF $PIECE(GMRA,U)'=""
WRITE " ",$$FMTE^XLFDT($PIECE(^GMR(120.85,+Y,0),U),"2S")
+3 IF $PIECE(GMRA,U,15)'=""
WRITE " ",$PIECE($GET(^GMR(120.8,$PIECE(GMRA,U,15),0)),U,2)
+4 WRITE $EXTRACT(@(DIC_+Y_",0)"),0)
+5 QUIT
SET ; set up variables for question mark help
+1 SET X=GMRANAM
SET DLAYGO=120.85
SET DIC="^GMR(120.85,"
SET DIC(0)="E"
SET D="D"
SET DIC("W")="D LKP^GMRAFDA1"
SET DZ="??"
+2 SET DIC("S")="I $P(^(0),U,2)=DFN S GMRA1208=+$P(^(0),U,15) I $$ERCHK^GMRAFDA1"
+3 QUIT
ERCHK() ; check for "ER" node to screen out entered-in-error entries
+1 IF '$DATA(^GMR(120.8,+GMRA1208,0))
QUIT 1
+2 IF '$DATA(^GMR(120.8,+GMRA1208,"ER"))
QUIT 1
+3 QUIT 0
