GMRAFN1 ;HIRMFO/WAA-FDA PART 1 MEDWATCH FORM ;11/30/95 15:18
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
Q:'GMRAPA1
K ^TMP($J,"GMR")
S GMRAPA(0)=$P($G(^GMR(120.85,GMRAPA1,0)),U,2) Q:GMRAPA(0)=""
Q:'$D(^DPT(GMRAPA(0),0)) S DFN=$P(GMRAPA(0),U) D 1^VADPT S GMRAID=$E(VADM(1),1)_$P($P(VADM(2),U,2),"-",3),GMRASEX=VADM(5),GMRADOB=$P(VADM(3),U) D KVAR^VADPT
S ^TMP($J,"FDAR",3)=$P(^DPT($P(GMRAPA(0),U),0),U,2)
S GMRAPA="" D ^GMRADSP7
S $P(LINE1,"-",133)="",$P(LINE2,"=",133)=""
S $P(TAB," ",133)=""
;GMRASUS=SUSPECTED AGENTS,GMRAPG1=TOTAL NUMBER OF PAGES
;GMRAPG2=CURRENT PAGE,GMRAFST=THIS IS THE FIRST PAGE IF 1
;IF 0 OTHER PAGE
S GMRAWEI="",DFN=$P(GMRAPA(0),U),GMRVSTR="WT" D EN6^GMRVUTL S GMRAWEI=$P(X,U,8)
K GMRAVIT1,GMRAVIT2
S (GMRAPG1,GMRAPG2,GMRAFST)=1,(GMRAXX,GMRASUS)=0 F S GMRASUS=$O(^GMR(120.85,GMRAPA1,3,GMRASUS)) Q:GMRASUS<1 D
.S GMRAXX=GMRAXX+1,^TMP($J,"GMR","A",GMRAXX)=$G(^GMR(120.85,GMRAPA1,3,GMRASUS,0))
.I GMRAXX>2 S:(GMRAXX#2) GMRAPG2=GMRAPG2+1
.;S GMRAPG2=GMRAPG2+(GMRAXX>1&'(GMRAXX#2))
.S:$G(^GMR(120.85,GMRAPA1,3,GMRASUS,1))'="" ^TMP($J,"GMR","A",GMRAXX,1)=^GMR(120.85,GMRAPA1,3,GMRASUS,1)
.S:$G(^GMR(120.85,GMRAPA1,3,GMRASUS,"LIKE"))'="" ^TMP($J,"GMR","A",GMRAXX,"LIKE")=^GMR(120.85,GMRAPA1,3,GMRASUS,"LIKE")
.Q
S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
S GMRASUS=0
F GMRAPG1=GMRAPG1:1:GMRAPG2 D ^GMRAFN2,^GMRAFN3,^GMRAFN4,^GMRAFN5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAFN1 1407 printed Dec 13, 2024@01:39:09 Page 2
GMRAFN1 ;HIRMFO/WAA-FDA PART 1 MEDWATCH FORM ;11/30/95 15:18
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+2 if 'GMRAPA1
QUIT
+3 KILL ^TMP($JOB,"GMR")
+4 SET GMRAPA(0)=$PIECE($GET(^GMR(120.85,GMRAPA1,0)),U,2)
if GMRAPA(0)=""
QUIT
+5 if '$DATA(^DPT(GMRAPA(0),0))
QUIT
SET DFN=$PIECE(GMRAPA(0),U)
DO 1^VADPT
SET GMRAID=$EXTRACT(VADM(1),1)_$PIECE($PIECE(VADM(2),U,2),"-",3)
SET GMRASEX=VADM(5)
SET GMRADOB=$PIECE(VADM(3),U)
DO KVAR^VADPT
+6 SET ^TMP($JOB,"FDAR",3)=$PIECE(^DPT($PIECE(GMRAPA(0),U),0),U,2)
+7 SET GMRAPA=""
DO ^GMRADSP7
+8 SET $PIECE(LINE1,"-",133)=""
SET $PIECE(LINE2,"=",133)=""
+9 SET $PIECE(TAB," ",133)=""
+10 ;GMRASUS=SUSPECTED AGENTS,GMRAPG1=TOTAL NUMBER OF PAGES
+11 ;GMRAPG2=CURRENT PAGE,GMRAFST=THIS IS THE FIRST PAGE IF 1
+12 ;IF 0 OTHER PAGE
+13 SET GMRAWEI=""
SET DFN=$PIECE(GMRAPA(0),U)
SET GMRVSTR="WT"
DO EN6^GMRVUTL
SET GMRAWEI=$PIECE(X,U,8)
+14 KILL GMRAVIT1,GMRAVIT2
+15 SET (GMRAPG1,GMRAPG2,GMRAFST)=1
SET (GMRAXX,GMRASUS)=0
FOR
SET GMRASUS=$ORDER(^GMR(120.85,GMRAPA1,3,GMRASUS))
if GMRASUS<1
QUIT
Begin DoDot:1
+16 SET GMRAXX=GMRAXX+1
SET ^TMP($JOB,"GMR","A",GMRAXX)=$GET(^GMR(120.85,GMRAPA1,3,GMRASUS,0))
+17 IF GMRAXX>2
if (GMRAXX#2)
SET GMRAPG2=GMRAPG2+1
+18 ;S GMRAPG2=GMRAPG2+(GMRAXX>1&'(GMRAXX#2))
+19 if $GET(^GMR(120.85,GMRAPA1,3,GMRASUS,1))'=""
SET ^TMP($JOB,"GMR","A",GMRAXX,1)=^GMR(120.85,GMRAPA1,3,GMRASUS,1)
+20 if $GET(^GMR(120.85,GMRAPA1,3,GMRASUS,"LIKE"))'=""
SET ^TMP($JOB,"GMR","A",GMRAXX,"LIKE")=^GMR(120.85,GMRAPA1,3,GMRASUS,"LIKE")
+21 QUIT
End DoDot:1
+22 SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))
+23 SET GMRASUS=0
+24 FOR GMRAPG1=GMRAPG1:1:GMRAPG2
DO ^GMRAFN2
DO ^GMRAFN3
DO ^GMRAFN4
DO ^GMRAFN5
+25 QUIT
