GMRAROBS.m

GMRAROBS ;HIRMFO/RFM,WAA-OBSERVED REACTION DATA EDIT ;12/22/04  10:37

 ;;4.0;Adverse Reaction Tracking;**8,21**;Mar 29, 1996

EN1 ; Entry for EDIT OBSERVED REACTION DATA option

 S GMRAOUT=0,GMRALAGO=1 D EN1^GMRAU85 G:GMRAPA1'>0 EXIT

 S GMRAPA=0 D ^GMRADSP7 D EN2

 D UNLOCK^GMRAUTL(120.85,GMRAPA1)

 D EXIT

 Q

EN2 ; ENTRY FROM ENTER/EDIT OPTION  GMRAPA1 AND GMRAPA ARE KNOWN

 S DIE="^GMR(120.85,",DA=GMRAPA1,DR=".01;.5//"_$$GET1^DIQ(200,DUZ_",",".01")_";14.5;22//"_$$DATE^GMRAUTL1($P(^GMR(120.85,DA,0),U)) D ^DIE G:$D(Y)!('$D(DA)) EXIT ;21

 D:'$D(GMRASITE) SITE^GMRAUTL S GMRASITE(0)=^GMRD(120.84,+GMRASITE,0)

 G:$P(GMRAPA(0),U,20)'["D" EXIT

 G:$P(GMRASITE(0),U,7)="y" FDA

 F  S %=1 W !,"Complete the FDA data" D YN^DICN S:%<0 %=2 Q:%  W !,"ENTER YES TO EDIT FDA DATA ENTER NO TO SKIP FDA DATA",$C(7)

 I %'=1 K % G EXIT

FDA D EN1^GMRAPEL0 G:GMRAOUT EXIT

FDA1 W @IOF,!,"Indicate which FDA Report Sections to be completed:"

 W !,"1.  Reaction Information",!,"2.  Suspect Drug(s) Information",!,"3.  Concomitant Drugs and History",!,"4.  Initial Reporter"

 K DIR S DIR("A")="Choose number(s) of sections to be edited",DIR(0)="LO^1:4"

 S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"

 S DIR("?",1)="ENTER THE NUMBER SECTION OR SECTIONS YOU WISH TO COMPLETE."

 S DIR("?",2)="YOU CAN ENTER:   YOU TYPE          SYSTEM WILL DO"

 S DIR("?",3)="   SECTION  -->    1                  SECTION 1"

 S DIR("?",4)="   RANGE    -->   2-4            SECTION 2 AND 3 AND 4"

 S DIR("?",5)="   GROUPS   -->  1,3,4           SECTION 1 AND 3 AND 4"

 S DIR("B")="1-4"

 D ^DIR K DIR G:$D(DIRUT)!(+Y'>0) EXIT

 K GMRAGHC F X=1:1 S GMRAX=$P(Y,",",X) Q:GMRAX']""  S GMRAGHC(GMRAX)=""

 F GMRAXXX=0:0 S GMRAXXX=$O(GMRAGHC(GMRAXXX)) Q:GMRAXXX'>0  D @GMRAXXX S:$D(Y) GMRAOUT=1 Q:GMRAOUT

EXIT ;

 K GMRAGHC,GMRAX,GMRAXXX,Y,X,DA,DIE,DR,GMRADT,GMRABGDT,GMRAENDT,XMB,XMY,VA

 Q

1 W @IOF D RXN^GMRAU851 Q:GMRAOUT  W ! S DA=GMRAPA1,DIE="^GMR(120.85,",DR="5T;6T;7T;9T;10T;11T;12.1T;12.2T" D ^DIE K GMRADT,GMRABGDT,GMRAENDT W !! D EN1^GMRALAB0 K GMRADT,GMRABGDT,GMRAENDT

 Q

2 W @IOF S GMRAOUT=0 K GMRADT,GMRABGDT,GMRAENDT D EN1^GMRAPHR2 K GMRADT,GMRABGDT,GMRAENDT

 Q

3 W @IOF S GMRAOUT=0 K GMRADT,GMRABGDT,GMRAENDT D EN1^GMRAPHR1 Q:GMRAOUT

 W ! S DA=GMRAPA1,DIE="^GMR(120.85,",DR="14" D ^DIE

 K GMRADT,GMRABGDT,GMRAENDT

 Q

4 N GMRAT W @IOF

 S GMRAT=$$GET1^DIQ(200,DUZ_",","8","I") ;21

 S:GMRAT'="" GMRAT=$P($G(^DIC(3.1,GMRAT,0)),U)

 S DIE="^GMR(120.85,",DA=GMRAPA1

 S DR="43//"_$$GET1^DIQ(200,DUZ_",",".01")_";44;45;46;47;48;49;50;51T;52T;52.1//"_GMRAT ;21

 D ^DIE

 Q

 ;

PTBUL ;Fire off the P&T FDA bul

 D NOW^%DTC

 ;1=PATIENT NAME

 ;2=PATIENT SSN

 ;3=REACTANT

 ;4=SIGNED OFF BY

 ;5=NOW

 S DFN=$P(GMRAPA(0),U) D PID^VADPT6

 S XMB(1)=$P(^DPT(DFN,0),U)

 S XMB(2)="("_VA("PID")_")" K VA

 S XMB(3)=$P(GMRAPA(0),U,2),XMB(4)=$$GET1^DIQ(200,DUZ_",",".01") ;21

 S Y=$$DATE^GMRAUTL1(%) S XMB(5)=Y,XMB="GMRA P&T COMMITTEE FDA"

 N GMRACNT S GMRACNT=0 K ^TMP("TIUP",$J) D ADDCOM^GMRAPET0("O",.GMRACNT) I $G(GMRACNT) S XMTEXT="^TMP(""TIUP"",$J)" ;21 Add originator comments to bulletin if they exist

 S XMY("G.GMRA P&T COMMITTEE FDA")=""

 D ^XMB

 Q

GMRAROBS  ;HIRMFO/RFM,WAA-OBSERVED REACTION DATA EDIT ;12/22/04  10:37

 +1       ;;4.0;Adverse Reaction Tracking;**8,21**;Mar 29, 1996

EN1       ; Entry for EDIT OBSERVED REACTION DATA option

 +1        SET GMRAOUT=0

           SET GMRALAGO=1

           DO EN1^GMRAU85

           IF GMRAPA1'>0

               GOTO EXIT

 +2        SET GMRAPA=0

           DO ^GMRADSP7

           DO EN2

 +3        DO UNLOCK^GMRAUTL(120.85,GMRAPA1)

 +4        DO EXIT

 +5        QUIT 

EN2       ; ENTRY FROM ENTER/EDIT OPTION  GMRAPA1 AND GMRAPA ARE KNOWN

 +1       ;21

           SET DIE="^GMR(120.85,"

           SET DA=GMRAPA1

           SET DR=".01;.5//"_$$GET1^DIQ(200,DUZ_",",".01")_";14.5;22//"_$$DATE^GMRAUTL1($PIECE(^GMR(120.85,DA,0),U))

           DO ^DIE

           IF $DATA(Y)!('$DATA(DA))

               GOTO EXIT

 +2        IF '$DATA(GMRASITE)

               DO SITE^GMRAUTL

           SET GMRASITE(0)=^GMRD(120.84,+GMRASITE,0)

 +3        IF $PIECE(GMRAPA(0),U,20)'["D"

               GOTO EXIT

 +4        IF $PIECE(GMRASITE(0),U,7)="y"

               GOTO FDA

 +5        FOR 

               SET %=1

               WRITE !,"Complete the FDA data"

               DO YN^DICN

               IF %<0

                   SET %=2

               IF %

                   QUIT 

               WRITE !,"ENTER YES TO EDIT FDA DATA ENTER NO TO SKIP FDA DATA",$CHAR(7)

 +6        IF %'=1

               KILL %

               GOTO EXIT

FDA        DO EN1^GMRAPEL0

           IF GMRAOUT

               GOTO EXIT

FDA1       WRITE @IOF,!,"Indicate which FDA Report Sections to be completed:"

 +1        WRITE !,"1.  Reaction Information",!,"2.  Suspect Drug(s) Information",!,"3.  Concomitant Drugs and History",!,"4.  Initial Reporter"

 +2        KILL DIR

           SET DIR("A")="Choose number(s) of sections to be edited"

           SET DIR(0)="LO^1:4"

 +3        SET DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"

 +4        SET DIR("?",1)="ENTER THE NUMBER SECTION OR SECTIONS YOU WISH TO COMPLETE."

 +5        SET DIR("?",2)="YOU CAN ENTER:   YOU TYPE          SYSTEM WILL DO"

 +6        SET DIR("?",3)="   SECTION  -->    1                  SECTION 1"

 +7        SET DIR("?",4)="   RANGE    -->   2-4            SECTION 2 AND 3 AND 4"

 +8        SET DIR("?",5)="   GROUPS   -->  1,3,4           SECTION 1 AND 3 AND 4"

 +9        SET DIR("B")="1-4"

 +10       DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!(+Y'>0)

               GOTO EXIT

 +11       KILL GMRAGHC

           FOR X=1:1

               SET GMRAX=$PIECE(Y,",",X)

               IF GMRAX']""

                   QUIT 

               SET GMRAGHC(GMRAX)=""

 +12       FOR GMRAXXX=0:0

               SET GMRAXXX=$ORDER(GMRAGHC(GMRAXXX))

               IF GMRAXXX'>0

                   QUIT 

               DO @GMRAXXX

               IF $DATA(Y)

                   SET GMRAOUT=1

               IF GMRAOUT

                   QUIT 

EXIT      ;

 +1        KILL GMRAGHC,GMRAX,GMRAXXX,Y,X,DA,DIE,DR,GMRADT,GMRABGDT,GMRAENDT,XMB,XMY,VA

 +2        QUIT 

1          WRITE @IOF

           DO RXN^GMRAU851

           IF GMRAOUT

               QUIT 

           WRITE !

           SET DA=GMRAPA1

           SET DIE="^GMR(120.85,"

           SET DR="5T;6T;7T;9T;10T;11T;12.1T;12.2T"

           DO ^DIE

           KILL GMRADT,GMRABGDT,GMRAENDT

           WRITE !!

           DO EN1^GMRALAB0

           KILL GMRADT,GMRABGDT,GMRAENDT

 +1        QUIT 

2          WRITE @IOF

           SET GMRAOUT=0

           KILL GMRADT,GMRABGDT,GMRAENDT

           DO EN1^GMRAPHR2

           KILL GMRADT,GMRABGDT,GMRAENDT

 +1        QUIT 

3          WRITE @IOF

           SET GMRAOUT=0

           KILL GMRADT,GMRABGDT,GMRAENDT

           DO EN1^GMRAPHR1

           IF GMRAOUT

               QUIT 

 +1        WRITE !

           SET DA=GMRAPA1

           SET DIE="^GMR(120.85,"

           SET DR="14"

           DO ^DIE

 +2        KILL GMRADT,GMRABGDT,GMRAENDT

 +3        QUIT 

4          NEW GMRAT

           WRITE @IOF

 +1       ;21

           SET GMRAT=$$GET1^DIQ(200,DUZ_",","8","I")

 +2        IF GMRAT'=""

               SET GMRAT=$PIECE($GET(^DIC(3.1,GMRAT,0)),U)

 +3        SET DIE="^GMR(120.85,"

           SET DA=GMRAPA1

 +4       ;21

           SET DR="43//"_$$GET1^DIQ(200,DUZ_",",".01")_";44;45;46;47;48;49;50;51T;52T;52.1//"_GMRAT

 +5        DO ^DIE

 +6        QUIT 

 +7       ;

PTBUL     ;Fire off the P&T FDA bul

 +1        DO NOW^%DTC

 +2       ;1=PATIENT NAME

 +3       ;2=PATIENT SSN

 +4       ;3=REACTANT

 +5       ;4=SIGNED OFF BY

 +6       ;5=NOW

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

           DO PID^VADPT6

 +8        SET XMB(1)=$PIECE(^DPT(DFN,0),U)

 +9        SET XMB(2)="("_VA("PID")_")"

           KILL VA

 +10      ;21

           SET XMB(3)=$PIECE(GMRAPA(0),U,2)

           SET XMB(4)=$$GET1^DIQ(200,DUZ_",",".01")

 +11       SET Y=$$DATE^GMRAUTL1(%)

           SET XMB(5)=Y

           SET XMB="GMRA P&T COMMITTEE FDA"

 +12      ;21 Add originator comments to bulletin if they exist

           NEW GMRACNT

           SET GMRACNT=0

           KILL ^TMP("TIUP",$JOB)

           DO ADDCOM^GMRAPET0("O",.GMRACNT)

           IF $GET(GMRACNT)

               SET XMTEXT="^TMP(""TIUP"",$J)"

 +13       SET XMY("G.GMRA P&T COMMITTEE FDA")=""

 +14       DO ^XMB

 +15       QUIT