GMRAVAM0.m

GMRAVAM0 ;HIRMFO/YMP,WAA,RM-DRIVER FOR VERIFIER ;7/30/04  14:42

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

EN1 ; Entry for VERIFY PATIENT REACTION DATA option

 I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) G NOVER

EN2 ;Select the type of Agent to verify

 S (GMRAOUT,GMRADFN)=0

 S DIR("A")="Would you like to verify a single patient's data"

 S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I $D(DIRUT) K DIRUT G EXIT

 ;If yes above, D ^DIC on Patient file S GMRADFN=+Y

 I Y D  G:GMRAOUT EXIT

 .W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC

 .I +Y<1!($D(DUOUT))!($D(DTOUT)) K DIC,DUOUT,DTOUT S GMRAOUT=1 Q

 .S GMRADFN=+Y

 .K DIC

 .Q

 D FF

 F I="Drug","Non-drug","Both" W !,?20,$E(I,1),?23,I

 K DIR S DIR(0)="SOMBA^D:DRUG;N:NON-DRUG;B:BOTH"

 S DIR("A")="Select type of AGENT to verify:(D/N/B): "

 S DIR("?",1)="ENTER D FOR DRUG AGENTS, N FOR NON-DRUG AGENTS"

 S DIR("?")="OR B FOR BOTH DRUG AND NON DRUG AGENTS."

 D ^DIR K DIR  I "^^"[Y G EXIT

 S GMRAFLAG=$S(Y="D":1,Y="N":0,1:2)

 K Y

 D FF

 S GMRAOUT=0 K ^TMP("GMRAV",$J),^TMP("GMRA",$J)

 I GMRADFN D VERPT

 I 'GMRADFN F GMRADFN=0:0 S GMRADFN=$O(^GMR(120.8,"AVER",GMRADFN)) Q:GMRADFN'>0  D VERPT

 I $O(^TMP("GMRAV",$J,""))="" W !,$C(7),"There isn't any ",$S(GMRAFLAG=1:"drug ",GMRAFLAG=0:"non-drug ",1:""),"allergy data to verify.",! G EN1

 G DISPLAY

 Q

VERPT ; Loop through all Patient GMRADFN's data to be verified and save

 ; in ^TMP("GMRAV",$J array.

 F GMRALL=0:0 S GMRALL=$O(^GMR(120.8,"AVER",GMRADFN,GMRALL)) Q:GMRALL'>0  D ARRAY

 Q

ARRAY S GMRAG=$G(^GMR(120.8,GMRALL,0))

 S %=$P(GMRAG,U,20),GMRADRUG=$S(%["D"&'(%["F"!(%["O")):1,%'["D":0,1:2)

 I GMRAFLAG=2!(GMRADRUG=2)!(GMRAFLAG=GMRADRUG) S ^TMP("GMRAV",$J,$P(^DPT(GMRADFN,0),"^"),$P(GMRAG,"^",2),GMRALL)=GMRAG Q

 Q

DISPLAY ;

 I GMRAOUT G EXIT

 I $O(^TMP("GMRAV",$J,0))="" G EXIT

 K GMRADIG D FF

 W !,?66,"OBS/"

 W !,?4,"PATIENT",?41,"ALLERGY",?66,"HIST",?71,"ADR",?75,"TYPE"

 W !,?4,"-------",?41,"-------",?66,"----",?71,"---",?75,"----",!

 S GMRANAME="",CX=0 F  S GMRANAME=$O(^TMP("GMRAV",$J,GMRANAME)) Q:GMRANAME=""!GMRAOUT  S GMRALLER="" D ALLERPR Q:CX<1  I GMRAOUT Q

 G:GMRAOUT EXIT

 G:$D(GMRADIG) SELL I GMRAOUT G EXIT

SELECT D SEL G:GMRAOUT EXIT

 I $D(GMRAY) G:GMRAY="" EXIT

 I GMRAOUT G EXIT

SELL F GMRAZ=1:1 S GMRANS=$P(GMRAY,",",GMRAZ) Q:GMRANS<1  Q:GMRAOUT!GMRAER  D SELT

 K ^TMP("GMRA",$J)

 G DISPLAY

SELT ;SELECT THE REACTIONS

 D FF

 N GMRAY,GMRAZ

 S GMRACHK=^TMP("GMRA",$J,GMRANS)

 S DFN=$P(GMRACHK,"^",2) D 1^VADPT S GMRALOC=$P(VAIN(4),"^",2),GMRANAM=VADM(1),GMRASEX=VADM(5) D KVAR^VADPT K VA,VAROOT

 S GMRADRUG=GMRAFLAG,GMRAOUT=0,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0)),GMRAPA=+GMRACHK,GMRAPA(0)=$P(GMRACHK,"^",2,999),GMRAVEDT=0

 Q:'$$LOCK^GMRAUTL(120.8,GMRAPA,1)

 D SITE^GMRAUTL,EN1^GMRAPEV0 S GMRALL=GMRAPA,GMRADFN=$P(^GMR(120.8,GMRAPA,0),U) D ARRAY

 I GMRAVER D EN1^GMRAPET0(GMRADFN,GMRAPA,"V",.GMRAOUT) I GMRAOUT S GMRAOUT=0

 I $G(GMRAERR),$G(GMRAOUT) S GMRAOUT=0 ;21

 I GMRAERR!GMRAVER S GMRANAME=$P($G(^DPT(+GMRAPA(0),0)),U),GMRALLER=$P(GMRAPA(0),U,2) K:GMRANAME]""&(GMRALLER]"") ^TMP("GMRAV",$J,GMRANAME,GMRALLER,GMRAPA)

 D UNLOCK^GMRAUTL(120.8,GMRAPA)

 Q

ALLERPR ;

 F  S GMRALLER=$O(^TMP("GMRAV",$J,GMRANAME,GMRALLER)) Q:GMRALLER=""!GMRAOUT!$D(GMRADIG)  F GMRAREC=0:0 S GMRAREC=$O(^TMP("GMRAV",$J,GMRANAME,GMRALLER,GMRAREC)) Q:GMRAREC'>0  D:$Y>(IOSL-5) SCREEN Q:GMRAOUT!$D(GMRADIG)  S CX=CX+1 D WRITE

 Q

WRITE S GMRAG=^TMP("GMRAV",$J,GMRANAME,GMRALLER,GMRAREC)

 S DFN=$P(GMRAG,U) D 1^VADPT S GMRALOC=$P(VAIN(4),"^",2) D PID^VADPT6 S GMRASSN=VA("BID")

 D KVAR^VADPT K VA,VAROOT

 W !,$J(CX,2),".",?4,$E(GMRANAME,1,20)," (",GMRASSN,") ",$E(GMRALOC,1,8),?41,$E(GMRALLER,1,23),?66

 W $S($P(GMRAG,"^",6)="o":"OBS",$P(GMRAG,"^",6)="h":"HIST",1:""),?71,$S($P(GMRAG,"^",14)="A":"NO",$P(GMRAG,"^",14)="P":"YES",1:"UNK")

 W ?75 D  ;This code is to allow for more than one type.

 .N X,GMRAY

 .S GMRAY=$P(GMRAG,"^",20)

 .F X=1:1:$L(GMRAY) W:X>1 !,?75 W $P("^FOOD^DRUG^OTHER","^",$F("FDO",$E(GMRAY,X)))

 .Q

 S ^TMP("GMRA",$J,CX)=GMRAREC_"^"_GMRAG

 Q

SCREEN W !,"TYPE '^' TO STOP OR"

 Q:GMRAOUT  D SEL Q:GMRAOUT

 I GMRAY="" D FF Q

 I GMRAOUT Q

 I GMRAER W !?4,$C(7),"ANSWER WITH A NUMBER BETWEEN 1 AND ",CX G SCREEN

 S GMRADIG=1

 Q

SEL ;

 Q:CX<1

 K DIR S DIR(0)="LOA^1:"_CX,DIR("A")="Select a number between 1-"_CX_": "

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

 D ^DIR K DIR

 S GMRAY=Y K Y

 I "^^"[GMRAY S GMRAOUT=$L(GMRAY) Q

 S GMRAER=0 F GMRAZ=1:1 S GMRAX=$P(GMRAY,",",GMRAZ) Q:GMRAX<1  D  Q:GMRAER

 .I '$D(^TMP("GMRA",$J,GMRAX)) W !,"ERROR INVALID SELECTION" S GMRAER=1

 .Q

 K GMRAX,GMRAZ Q

NOVER ;

 W !!?5,$C(7),"You do not have the 'GMRA-ALLERGY VERIFY' Security Key."

EXIT ;

 K ^TMP("GMRAV",$J),^TMP("GMRA",$J)

 D KILL^XUSCLEAN

 Q

FF ;

 W #

 Q

GMRAVAM0  ;HIRMFO/YMP,WAA,RM-DRIVER FOR VERIFIER ;7/30/04  14:42

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

EN1       ; Entry for VERIFY PATIENT REACTION DATA option

 +1        IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))

               GOTO NOVER

EN2       ;Select the type of Agent to verify

 +1        SET (GMRAOUT,GMRADFN)=0

 +2        SET DIR("A")="Would you like to verify a single patient's data"

 +3        SET DIR(0)="Y"

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               KILL DIRUT

               GOTO EXIT

 +4       ;If yes above, D ^DIC on Patient file S GMRADFN=+Y

 +5        IF Y

               Begin DoDot:1

 +6                WRITE !

                   SET DIC="^DPT("

                   SET DIC(0)="AEQM"

                   DO ^DIC

 +7                IF +Y<1!($DATA(DUOUT))!($DATA(DTOUT))

                       KILL DIC,DUOUT,DTOUT

                       SET GMRAOUT=1

                       QUIT 

 +8                SET GMRADFN=+Y

 +9                KILL DIC

 +10               QUIT 

               End DoDot:1

               IF GMRAOUT

                   GOTO EXIT

 +11       DO FF

 +12       FOR I="Drug","Non-drug","Both"

               WRITE !,?20,$EXTRACT(I,1),?23,I

 +13       KILL DIR

           SET DIR(0)="SOMBA^D:DRUG;N:NON-DRUG;B:BOTH"

 +14       SET DIR("A")="Select type of AGENT to verify:(D/N/B): "

 +15       SET DIR("?",1)="ENTER D FOR DRUG AGENTS, N FOR NON-DRUG AGENTS"

 +16       SET DIR("?")="OR B FOR BOTH DRUG AND NON DRUG AGENTS."

 +17       DO ^DIR

           KILL DIR

           IF "^^"[Y

               GOTO EXIT

 +18       SET GMRAFLAG=$SELECT(Y="D":1,Y="N":0,1:2)

 +19       KILL Y

 +20       DO FF

 +21       SET GMRAOUT=0

           KILL ^TMP("GMRAV",$JOB),^TMP("GMRA",$JOB)

 +22       IF GMRADFN

               DO VERPT

 +23       IF 'GMRADFN

               FOR GMRADFN=0:0

                   SET GMRADFN=$ORDER(^GMR(120.8,"AVER",GMRADFN))

                   IF GMRADFN'>0

                       QUIT 

                   DO VERPT

 +24       IF $ORDER(^TMP("GMRAV",$JOB,""))=""

               WRITE !,$CHAR(7),"There isn't any ",$SELECT(GMRAFLAG=1:"drug ",GMRAFLAG=0:"non-drug ",1:""),"allergy data to verify.",!

               GOTO EN1

 +25       GOTO DISPLAY

 +26       QUIT 

VERPT     ; Loop through all Patient GMRADFN's data to be verified and save

 +1       ; in ^TMP("GMRAV",$J array.

 +2        FOR GMRALL=0:0

               SET GMRALL=$ORDER(^GMR(120.8,"AVER",GMRADFN,GMRALL))

               IF GMRALL'>0

                   QUIT 

               DO ARRAY

 +3        QUIT 

ARRAY      SET GMRAG=$GET(^GMR(120.8,GMRALL,0))

 +1        SET %=$PIECE(GMRAG,U,20)

           SET GMRADRUG=$SELECT(%["D"&'(%["F"!(%["O")):1,%'["D":0,1:2)

 +2        IF GMRAFLAG=2!(GMRADRUG=2)!(GMRAFLAG=GMRADRUG)

               SET ^TMP("GMRAV",$JOB,$PIECE(^DPT(GMRADFN,0),"^"),$PIECE(GMRAG,"^",2),GMRALL)=GMRAG

               QUIT 

 +3        QUIT 

DISPLAY   ;

 +1        IF GMRAOUT

               GOTO EXIT

 +2        IF $ORDER(^TMP("GMRAV",$JOB,0))=""

               GOTO EXIT

 +3        KILL GMRADIG

           DO FF

 +4        WRITE !,?66,"OBS/"

 +5        WRITE !,?4,"PATIENT",?41,"ALLERGY",?66,"HIST",?71,"ADR",?75,"TYPE"

 +6        WRITE !,?4,"-------",?41,"-------",?66,"----",?71,"---",?75,"----",!

 +7        SET GMRANAME=""

           SET CX=0

           FOR 

               SET GMRANAME=$ORDER(^TMP("GMRAV",$JOB,GMRANAME))

               IF GMRANAME=""!GMRAOUT

                   QUIT 

               SET GMRALLER=""

               DO ALLERPR

               IF CX<1

                   QUIT 

               IF GMRAOUT

                   QUIT 

 +8        IF GMRAOUT

               GOTO EXIT

 +9        IF $DATA(GMRADIG)

               GOTO SELL

           IF GMRAOUT

               GOTO EXIT

SELECT     DO SEL

           IF GMRAOUT

               GOTO EXIT

 +1        IF $DATA(GMRAY)

               IF GMRAY=""

                   GOTO EXIT

 +2        IF GMRAOUT

               GOTO EXIT

SELL       FOR GMRAZ=1:1

               SET GMRANS=$PIECE(GMRAY,",",GMRAZ)

               IF GMRANS<1

                   QUIT 

               IF GMRAOUT!GMRAER

                   QUIT 

               DO SELT

 +1        KILL ^TMP("GMRA",$JOB)

 +2        GOTO DISPLAY

SELT      ;SELECT THE REACTIONS

 +1        DO FF

 +2        NEW GMRAY,GMRAZ

 +3        SET GMRACHK=^TMP("GMRA",$JOB,GMRANS)

 +4        SET DFN=$PIECE(GMRACHK,"^",2)

           DO 1^VADPT

           SET GMRALOC=$PIECE(VAIN(4),"^",2)

           SET GMRANAM=VADM(1)

           SET GMRASEX=VADM(5)

           DO KVAR^VADPT

           KILL VA,VAROOT

 +5        SET GMRADRUG=GMRAFLAG

           SET GMRAOUT=0

           SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))

           SET GMRAPA=+GMRACHK

           SET GMRAPA(0)=$PIECE(GMRACHK,"^",2,999)

           SET GMRAVEDT=0

 +6        IF '$$LOCK^GMRAUTL(120.8,GMRAPA,1)

               QUIT 

 +7        DO SITE^GMRAUTL

           DO EN1^GMRAPEV0

           SET GMRALL=GMRAPA

           SET GMRADFN=$PIECE(^GMR(120.8,GMRAPA,0),U)

           DO ARRAY

 +8        IF GMRAVER

               DO EN1^GMRAPET0(GMRADFN,GMRAPA,"V",.GMRAOUT)

               IF GMRAOUT

                   SET GMRAOUT=0

 +9       ;21

           IF $GET(GMRAERR)

               IF $GET(GMRAOUT)

                   SET GMRAOUT=0

 +10       IF GMRAERR!GMRAVER

               SET GMRANAME=$PIECE($GET(^DPT(+GMRAPA(0),0)),U)

               SET GMRALLER=$PIECE(GMRAPA(0),U,2)

               IF GMRANAME]""&(GMRALLER]"")

                   KILL ^TMP("GMRAV",$JOB,GMRANAME,GMRALLER,GMRAPA)

 +11       DO UNLOCK^GMRAUTL(120.8,GMRAPA)

 +12       QUIT 

ALLERPR   ;

 +1        FOR 

               SET GMRALLER=$ORDER(^TMP("GMRAV",$JOB,GMRANAME,GMRALLER))

               IF GMRALLER=""!GMRAOUT!$DATA(GMRADIG)

                   QUIT 

               FOR GMRAREC=0:0

                   SET GMRAREC=$ORDER(^TMP("GMRAV",$JOB,GMRANAME,GMRALLER,GMRAREC))

                   IF GMRAREC'>0

                       QUIT 

                   IF $Y>(IOSL-5)

                       DO SCREEN

                   IF GMRAOUT!$DATA(GMRADIG)

                       QUIT 

                   SET CX=CX+1

                   DO WRITE

 +2        QUIT 

WRITE      SET GMRAG=^TMP("GMRAV",$JOB,GMRANAME,GMRALLER,GMRAREC)

 +1        SET DFN=$PIECE(GMRAG,U)

           DO 1^VADPT

           SET GMRALOC=$PIECE(VAIN(4),"^",2)

           DO PID^VADPT6

           SET GMRASSN=VA("BID")

 +2        DO KVAR^VADPT

           KILL VA,VAROOT

 +3        WRITE !,$JUSTIFY(CX,2),".",?4,$EXTRACT(GMRANAME,1,20)," (",GMRASSN,") ",$EXTRACT(GMRALOC,1,8),?41,$EXTRACT(GMRALLER,1,23),?66

 +4        WRITE $SELECT($PIECE(GMRAG,"^",6)="o":"OBS",$PIECE(GMRAG,"^",6)="h":"HIST",1:""),?71,$SELECT($PIECE(GMRAG,"^",14)="A":"NO",$PIECE(GMRAG,"^",14)="P":"YES",1:"UNK")

 +5       ;This code is to allow for more than one type.

           WRITE ?75

           Begin DoDot:1

 +6            NEW X,GMRAY

 +7            SET GMRAY=$PIECE(GMRAG,"^",20)

 +8            FOR X=1:1:$LENGTH(GMRAY)

                   IF X>1

                       WRITE !,?75

                   WRITE $PIECE("^FOOD^DRUG^OTHER","^",$FIND("FDO",$EXTRACT(GMRAY,X)))

 +9            QUIT 

           End DoDot:1

 +10       SET ^TMP("GMRA",$JOB,CX)=GMRAREC_"^"_GMRAG

 +11       QUIT 

SCREEN     WRITE !,"TYPE '^' TO STOP OR"

 +1        IF GMRAOUT

               QUIT 

           DO SEL

           IF GMRAOUT

               QUIT 

 +2        IF GMRAY=""

               DO FF

               QUIT 

 +3        IF GMRAOUT

               QUIT 

 +4        IF GMRAER

               WRITE !?4,$CHAR(7),"ANSWER WITH A NUMBER BETWEEN 1 AND ",CX

               GOTO SCREEN

 +5        SET GMRADIG=1

 +6        QUIT 

SEL       ;

 +1        IF CX<1

               QUIT 

 +2        KILL DIR

           SET DIR(0)="LOA^1:"_CX

           SET DIR("A")="Select a number between 1-"_CX_": "

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

 +4        DO ^DIR

           KILL DIR

 +5        SET GMRAY=Y

           KILL Y

 +6        IF "^^"[GMRAY

               SET GMRAOUT=$LENGTH(GMRAY)

               QUIT 

 +7        SET GMRAER=0

           FOR GMRAZ=1:1

               SET GMRAX=$PIECE(GMRAY,",",GMRAZ)

               IF GMRAX<1

                   QUIT 

               Begin DoDot:1

 +8                IF '$DATA(^TMP("GMRA",$JOB,GMRAX))

                       WRITE !,"ERROR INVALID SELECTION"

                       SET GMRAER=1

 +9                QUIT 

               End DoDot:1

               IF GMRAER

                   QUIT 

 +10       KILL GMRAX,GMRAZ

           QUIT 

NOVER     ;

 +1        WRITE !!?5,$CHAR(7),"You do not have the 'GMRA-ALLERGY VERIFY' Security Key."

EXIT      ;

 +1        KILL ^TMP("GMRAV",$JOB),^TMP("GMRA",$JOB)

 +2        DO KILL^XUSCLEAN

 +3        QUIT 

FF        ;

 +1        WRITE #

 +2        QUIT