GMRAFN1.m

GMRAFN1 ;HIRMFO/WAA-FDA PART 1 MEDWATCH FORM ;11/30/95  15:18 [ 04/30/2002  4:07 PM ]

 ;;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

 ;IHS/ITSC/ENM 04/30/02 CALL TO GMRVUTL DISABLED

 S GMRAWEI="",DFN=$P(GMRAPA(0),U),GMRVSTR="WT" ;D EN6^GMRVUTL S GMRAWEI=$P(X,U,8)

 ;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

GMRAFN1   ;HIRMFO/WAA-FDA PART 1 MEDWATCH FORM ;11/30/95  15:18 [ 04/30/2002  4:07 PM ]

 +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      ;IHS/ITSC/ENM 04/30/02 CALL TO GMRVUTL DISABLED

 +14      ;D EN6^GMRVUTL S GMRAWEI=$P(X,U,8)

           SET GMRAWEI=""

           SET DFN=$PIECE(GMRAPA(0),U)

           SET GMRVSTR="WT"

 +15      ;S GMRAWEI="",DFN=$P(GMRAPA(0),U),GMRVSTR="WT" D EN6^GMRVUTL S GMRAWEI=$P(X,U,8)

 +16       KILL GMRAVIT1,GMRAVIT2

 +17       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

 +18               SET GMRAXX=GMRAXX+1

                   SET ^TMP($JOB,"GMR","A",GMRAXX)=$GET(^GMR(120.85,GMRAPA1,3,GMRASUS,0))

 +19               IF GMRAXX>2

                       IF (GMRAXX#2)

                           SET GMRAPG2=GMRAPG2+1

 +20      ;S GMRAPG2=GMRAPG2+(GMRAXX>1&'(GMRAXX#2))

 +21               IF $GET(^GMR(120.85,GMRAPA1,3,GMRASUS,1))'=""

                       SET ^TMP($JOB,"GMR","A",GMRAXX,1)=^GMR(120.85,GMRAPA1,3,GMRASUS,1)

 +22               IF $GET(^GMR(120.85,GMRAPA1,3,GMRASUS,"LIKE"))'=""

                       SET ^TMP($JOB,"GMR","A",GMRAXX,"LIKE")=^GMR(120.85,GMRAPA1,3,GMRASUS,"LIKE")

 +23               QUIT 

               End DoDot:1

 +24       SET GMRAPA1(0)=$GET(^GMR(120.85,GMRAPA1,0))

 +25       SET GMRASUS=0

 +26       FOR GMRAPG1=GMRAPG1:1:GMRAPG2

               DO ^GMRAFN2

               DO ^GMRAFN3

               DO ^GMRAFN4

               DO ^GMRAFN5

 +27       QUIT