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