GMRADSP4.m

GMRADSP4 ;HIRMFO/YMP,RM,WAA,FT-PATIENT'S ALLERGIES PRINTOUT ;04-Nov-2010 09:11;DU

 ;;4.0;Adverse Reaction Tracking;**5,7,8,1002**;Mar 29, 1996;Build 32

 ;MSC/IHS/MGH  Add list for inactive allergies Patch 1002

EN1 ; Entry to PRINT PATIENT REACTION DATA option

 W ! S DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select PATIENT: " D ^DIC K DIC,DLAYGO I +Y'>0 S GMRAOUT=1 G EXIT

 S DFN=+Y

 S GMRAEER=$$ERR(DFN)

 I '$D(^GMR(120.86,DFN,0)) W !!,$C(7),"NO ",$S(GMRAEER:"ACTIVE ",1:""),"ALLERGY/ADVERSE REACTION DATA EXISTS FOR THIS PATIENT",! W:GMRAEER "HOWEVER, THERE IS DATA ENTERED IN ERROR ON FILE",! G EN1:'GMRAEER

 I $P($G(^GMR(120.86,DFN,0)),U,2)=0 W !!,$C(7),"PATIENT HAS ANSWERED NKA",$S(GMRAEER:" BUT HAS ""ENTERED IN ERROR"" DATA ON FILE",1:"") G:'GMRAEER EN1 W !

 S GMRAOUT=0,GMRALINE=$$REPEAT^XLFSTR("=",32),GMRASLIN=$$REPEAT^XLFSTR("-",32)

 D DEM^VADPT

 S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTION REPORTS",53)

 S GMRAHEAD(2)=$J($E(VADM(1),1,15),1)_$J(VA("PID"),21)_$J($P(VADM(3),"^",2),24)_$J($S(VADM(4):"("_VADM(4)_")",1:""),5) D KVAR^VADPT K VA S (GMRAHEAD(3),GMRAHEAD(4))="",$P(GMRAHEAD(3),"-",81)=""

 S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")

 S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,53)

DIR1 K DIR S DIR("A",1)="Select 1:DRUG, 2:FOOD, 3:OTHER",DIR(0)="LO^1:3",DIR("A")="Type of allergy"

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

 D ^DIR K DIR

 G:'$D(Y(0)) EN1 S GMRASEL1=Y(0)

 S GMRATTMP="" F X=1:1:3 I GMRASEL1[X S GMRATTMP=GMRATTMP_$E("DFO",X)

 S GMRASEL=GMRATTMP

 K GMRATTMP

 K DIR S DIR("A",1)="Select 1:ACTIVE, 2:ENTERED IN ERROR, 3:INACTIVE",DIR(0)="LO^1:3",DIR("A")="Which would you like to see?"

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

 D ^DIR K DIR

 G:Y["^"!'$D(Y(0)) EN1 S GMRASEL2=Y(0)

 K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT

 I $D(IO("Q")) D TASK G EXIT

BEGIN K ^TMP($J,"GMRADSP") S GMRANKA=0 F GMRARECN=0:0 S GMRARECN=$O(^GMR(120.8,"B",DFN,GMRARECN)) Q:GMRARECN'>0!GMRAOUT  D SET

 G PARSE

 Q

SET ; SET SORT ARRAY

 S GMRANKA=$P($G(^GMR(120.86,DFN,0)),U,2) I GMRANKA'=1&(GMRASEL2'[2) Q

 S GMRATEMP=^GMR(120.8,GMRARECN,0),GMRAKIND=$P(GMRATEMP,"^",20)

 S GMRAEER=$S(+$G(^GMR(120.8,GMRARECN,"ER")):1,1:0)

 ;IHS/MSC/MGH Designate inactive allergies

 N Z,GMRAACT,GMRARE

 S Z=$O(^GMR(120.8,GMRARECN,9999999.12,$C(0)),-1) I +Z D

 .S GMRAACT=$P($G(^GMR(120.8,GMRARECN,9999999.12,Z,0)),U,1)

 .S GMRARE=$P($G(^GMR(120.8,GMRARECN,9999999.12,Z,0)),U,4)

 .I +GMRAACT&(GMRARE="") S GMRAEER=2,GMRAIN=1

 F %=1:1:$L(GMRASEL) I GMRAKIND[$E(GMRASEL,%) Q:'$P(GMRATEMP,"^",12)&('GMRAEER)  D

 .S ^TMP($J,"GMRADSP",GMRAEER,GMRAKIND,$P(GMRATEMP,"^",2),GMRARECN)="" Q

 Q

PARSE ;

 S GMRAPG=0,GMRAFG=0,GMRACNT=0 D HDR^GMRADSP3

 I 'GMRANKA&(GMRASEL2'[2) W !,"   This patient has No Known Allergies." Q

 F GMRAZK=1:1:$L(GMRASEL2,",")-1 D

 .S GMRACTIV=$S($P(GMRASEL2,",",GMRAZK)=1:0,$P(GMRASEL2,",",GMRAZK)=2:1,$P(GMRASEL2,",",GMRAZK)=3:2,GMRZ1:"")

 .S GMRASTAT=$S(GMRACTIV=0:"ACTIVE",GMRACTIV=1:"E/E",GMRACTIV=2:"INACTIVE",1:"") D:GMRACTIV]"" PARSE2 Q:GMRAOUT

 I 'GMRACNT W !!,"THERE IS NO DATA FOR THIS REPORT."

EXIT ;Quit and kill

 D CLOSE^GMRAUTL

 K ^TMP($J,"GMRADSP")

 D KILL^XUSCLEAN

 Q

PARSE2 ;

 S GMRATYP=""

 F  S GMRATYP=$O(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP)) Q:GMRATYP=""  D PARSECD Q:GMRAOUT

 Q

PARSECD ;

 W:$D(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP)) !,"STATUS: "_GMRASTAT,!,$E(GMRASLIN,1,$L(GMRASTAT)+8)

 S GMRARES=$$OUTTYPE^GMRAUTL(GMRATYP) W:GMRARES'=""&$D(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP)) !,?2,"TYPE: ",GMRARES,!,?2,$E(GMRALINE,1,6+$L(GMRARES)),!

 S GMRAALL=""

 F GMRAZM=0:0 S GMRAALL=$O(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL)) Q:GMRAALL=""!GMRAOUT  D

 .   S GMRAREC="" F  S GMRAREC=$O(^TMP($J,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL,GMRAREC)) Q:GMRAREC=""!GMRAOUT  D

 .   .   S GMRAPA(0)=$G(^GMR(120.8,GMRAREC,0))

 .   .   S GMRANS="",GMRAPA=GMRAREC,GMRAAL=GMRAALL,GMRACNT=GMRACNT+1

 .   .   S GMRADRUG=($O(^GMR(120.8,GMRAPA,2,0))!$O(^GMR(120.8,GMRAPA,3,0))!$P(GMRAPA(0),"^",20)["D"!$S($P(GMRAPA(0),"^",3)[";PS":1,$P(GMRAPA(0),"^",3)[120.82:$S($D(^GMRD(120.82,+$P(GMRAPA(0),"^",3),0)):$P(^(0),"^",2)["D",1:0),1:0))

 .   .   S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",""))

 .   .   S GMRAPRNT=1 U:IO IO D EN1^GMRADSP2

 .   .   I 'GMRAOUT W !,".............................................................................." S GMRAFG=1

 .   .   Q

 .   Q

 Q

TASK ;

 S ZTDESC="GMRA Print Complete List of Patient's Reactions",ZTRTN="BEGIN^GMRADSP4",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD

 W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")

 K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK

 Q

ERR(DFN) ;Checks to see if patient has entered in error data

 N ERR,NUM

 S NUM=0,ERR=0

 F  S NUM=$O(^GMR(120.8,"B",DFN,NUM)) Q:'+NUM  S:+$G(^GMR(120.8,NUM,"ER")) ERR=1 Q:ERR

 Q ERR

GMRADSP4  ;HIRMFO/YMP,RM,WAA,FT-PATIENT'S ALLERGIES PRINTOUT ;04-Nov-2010 09:11;DU

 +1       ;;4.0;Adverse Reaction Tracking;**5,7,8,1002**;Mar 29, 1996;Build 32

 +2       ;MSC/IHS/MGH  Add list for inactive allergies Patch 1002

EN1       ; Entry to PRINT PATIENT REACTION DATA option

 +1        WRITE !

           SET DIC="^DPT("

           SET DIC(0)="AEQM"

           SET DIC("A")="Select PATIENT: "

           DO ^DIC

           KILL DIC,DLAYGO

           IF +Y'>0

               SET GMRAOUT=1

               GOTO EXIT

 +2        SET DFN=+Y

 +3        SET GMRAEER=$$ERR(DFN)

 +4        IF '$DATA(^GMR(120.86,DFN,0))

               WRITE !!,$CHAR(7),"NO ",$SELECT(GMRAEER:"ACTIVE ",1:""),"ALLERGY/ADVERSE REACTION DATA EXISTS FOR THIS PATIENT",!

               IF GMRAEER

                   WRITE "HOWEVER, THERE IS DATA ENTERED IN ERROR ON FILE",!

               IF 'GMRAEER

                   GOTO EN1

 +5        IF $PIECE($GET(^GMR(120.86,DFN,0)),U,2)=0

               WRITE !!,$CHAR(7),"PATIENT HAS ANSWERED NKA",$SELECT(GMRAEER:" BUT HAS ""ENTERED IN ERROR"" DATA ON FILE",1:"")

               IF 'GMRAEER

                   GOTO EN1

               WRITE !

 +6        SET GMRAOUT=0

           SET GMRALINE=$$REPEAT^XLFSTR("=",32)

           SET GMRASLIN=$$REPEAT^XLFSTR("-",32)

 +7        DO DEM^VADPT

 +8        SET GMRAHEAD(1)=$JUSTIFY("ALLERGY/ADVERSE REACTION REPORTS",53)

 +9        SET GMRAHEAD(2)=$JUSTIFY($EXTRACT(VADM(1),1,15),1)_$JUSTIFY(VA("PID"),21)_$JUSTIFY($PIECE(VADM(3),"^",2),24)_$JUSTIFY($SELECT(VADM(4):"("_VADM(4)_")",1:""),5)

           DO KVAR^VADPT

           KILL VA

           SET (GMRAHEAD(3),GMRAHEAD(4))=""

           SET $PIECE(GMRAHEAD(3),"-",81)=""

 +10       SET GMRANOW=$$NOW^XLFDT

           SET GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")

 +11       SET GMRAHEAD(1.5)=$JUSTIFY("Run Date/Time: "_GMRANOW,53)

DIR1       KILL DIR

           SET DIR("A",1)="Select 1:DRUG, 2:FOOD, 3:OTHER"

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

           SET DIR("A")="Type of allergy"

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

 +1        DO ^DIR

           KILL DIR

 +2        IF '$DATA(Y(0))

               GOTO EN1

           SET GMRASEL1=Y(0)

 +3        SET GMRATTMP=""

           FOR X=1:1:3

               IF GMRASEL1[X

                   SET GMRATTMP=GMRATTMP_$EXTRACT("DFO",X)

 +4        SET GMRASEL=GMRATTMP

 +5        KILL GMRATTMP

 +6        KILL DIR

           SET DIR("A",1)="Select 1:ACTIVE, 2:ENTERED IN ERROR, 3:INACTIVE"

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

           SET DIR("A")="Which would you like to see?"

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

 +8        DO ^DIR

           KILL DIR

 +9        IF Y["^"!'$DATA(Y(0))

               GOTO EN1

           SET GMRASEL2=Y(0)

 +10       KILL GMRAZIS

           DO DEV^GMRAUTL

           IF POP

               SET GMRAOUT=1

               GOTO EXIT

 +11       IF $DATA(IO("Q"))

               DO TASK

               GOTO EXIT

BEGIN      KILL ^TMP($JOB,"GMRADSP")

           SET GMRANKA=0

           FOR GMRARECN=0:0

               SET GMRARECN=$ORDER(^GMR(120.8,"B",DFN,GMRARECN))

               IF GMRARECN'>0!GMRAOUT

                   QUIT 

               DO SET

 +1        GOTO PARSE

 +2        QUIT 

SET       ; SET SORT ARRAY

 +1        SET GMRANKA=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)

           IF GMRANKA'=1&(GMRASEL2'[2)

               QUIT 

 +2        SET GMRATEMP=^GMR(120.8,GMRARECN,0)

           SET GMRAKIND=$PIECE(GMRATEMP,"^",20)

 +3        SET GMRAEER=$SELECT(+$GET(^GMR(120.8,GMRARECN,"ER")):1,1:0)

 +4       ;IHS/MSC/MGH Designate inactive allergies

 +5        NEW Z,GMRAACT,GMRARE

 +6        SET Z=$ORDER(^GMR(120.8,GMRARECN,9999999.12,$CHAR(0)),-1)

           IF +Z

               Begin DoDot:1

 +7                SET GMRAACT=$PIECE($GET(^GMR(120.8,GMRARECN,9999999.12,Z,0)),U,1)

 +8                SET GMRARE=$PIECE($GET(^GMR(120.8,GMRARECN,9999999.12,Z,0)),U,4)

 +9                IF +GMRAACT&(GMRARE="")

                       SET GMRAEER=2

                       SET GMRAIN=1

               End DoDot:1

 +10       FOR %=1:1:$LENGTH(GMRASEL)

               IF GMRAKIND[$EXTRACT(GMRASEL,%)

                   IF '$PIECE(GMRATEMP,"^",12)&('GMRAEER)

                       QUIT 

                   Begin DoDot:1

 +11                   SET ^TMP($JOB,"GMRADSP",GMRAEER,GMRAKIND,$PIECE(GMRATEMP,"^",2),GMRARECN)=""

                       QUIT 

                   End DoDot:1

 +12       QUIT 

PARSE     ;

 +1        SET GMRAPG=0

           SET GMRAFG=0

           SET GMRACNT=0

           DO HDR^GMRADSP3

 +2        IF 'GMRANKA&(GMRASEL2'[2)

               WRITE !,"   This patient has No Known Allergies."

               QUIT 

 +3        FOR GMRAZK=1:1:$LENGTH(GMRASEL2,",")-1

               Begin DoDot:1

 +4                SET GMRACTIV=$SELECT($PIECE(GMRASEL2,",",GMRAZK)=1:0,$PIECE(GMRASEL2,",",GMRAZK)=2:1,$PIECE(GMRASEL2,",",GMRAZK)=3:2,GMRZ1:"")

 +5                SET GMRASTAT=$SELECT(GMRACTIV=0:"ACTIVE",GMRACTIV=1:"E/E",GMRACTIV=2:"INACTIVE",1:"")

                   IF GMRACTIV]""

                       DO PARSE2

                   IF GMRAOUT

                       QUIT 

               End DoDot:1

 +6        IF 'GMRACNT

               WRITE !!,"THERE IS NO DATA FOR THIS REPORT."

EXIT      ;Quit and kill

 +1        DO CLOSE^GMRAUTL

 +2        KILL ^TMP($JOB,"GMRADSP")

 +3        DO KILL^XUSCLEAN

 +4        QUIT 

PARSE2    ;

 +1        SET GMRATYP=""

 +2        FOR 

               SET GMRATYP=$ORDER(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP))

               IF GMRATYP=""

                   QUIT 

               DO PARSECD

               IF GMRAOUT

                   QUIT 

 +3        QUIT 

PARSECD   ;

 +1        IF $DATA(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP))

               WRITE !,"STATUS: "_GMRASTAT,!,$EXTRACT(GMRASLIN,1,$LENGTH(GMRASTAT)+8)

 +2        SET GMRARES=$$OUTTYPE^GMRAUTL(GMRATYP)

           IF GMRARES'=""&$DATA(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP))

               WRITE !,?2,"TYPE: ",GMRARES,!,?2,$EXTRACT(GMRALINE,1,6+$LENGTH(GMRARES)),!

 +3        SET GMRAALL=""

 +4        FOR GMRAZM=0:0

               SET GMRAALL=$ORDER(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL))

               IF GMRAALL=""!GMRAOUT

                   QUIT 

               Begin DoDot:1

 +5                SET GMRAREC=""

                   FOR 

                       SET GMRAREC=$ORDER(^TMP($JOB,"GMRADSP",GMRACTIV,GMRATYP,GMRAALL,GMRAREC))

                       IF GMRAREC=""!GMRAOUT

                           QUIT 

                       Begin DoDot:2

 +6                        SET GMRAPA(0)=$GET(^GMR(120.8,GMRAREC,0))

 +7                        SET GMRANS=""

                           SET GMRAPA=GMRAREC

                           SET GMRAAL=GMRAALL

                           SET GMRACNT=GMRACNT+1

 +8                       SET GMRADRUG=($ORDER(^GMR(120.8,GMRAPA,2,0))!$ORDER(^GMR(120.8,GMRAPA,3,0))!$PIECE(GMRAPA(0),"^",20)["D"!$SELECT($PIECE(GMRAPA(0),"^",3)[";PS":1,$PIECE(GMRAPA(0),"^",3)[120.82:$SELECT(...

                           ... $DATA(^GMRD(120.82,+$PIECE(GMRAPA(0),"^",3),0)):$PIECE(^(0),"^",2)["D",1:0),1:0))

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

 +10                       SET GMRAPRNT=1

                           IF IO

                               USE IO

                           DO EN1^GMRADSP2

 +11                       IF 'GMRAOUT

                               WRITE !,".............................................................................."

                               SET GMRAFG=1

 +12                       QUIT 

                       End DoDot:2

 +13               QUIT 

               End DoDot:1

 +14       QUIT 

TASK      ;

 +1        SET ZTDESC="GMRA Print Complete List of Patient's Reactions"

           SET ZTRTN="BEGIN^GMRADSP4"

           SET ZTDTH=""

           SET ZTIO=ION

           SET ZTSAVE("GMRA*")=""

           SET ZTSAVE("DFN")=""

           DO ^%ZTLOAD

 +2        WRITE !!,$SELECT($DATA(ZTSK):"Request queued...",1:"Request NOT queued please try later...")

 +3        KILL ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK

 +4        QUIT 

ERR(DFN)  ;Checks to see if patient has entered in error data

 +1        NEW ERR,NUM

 +2        SET NUM=0

           SET ERR=0

 +3        FOR 

               SET NUM=$ORDER(^GMR(120.8,"B",DFN,NUM))

               IF '+NUM

                   QUIT 

               IF +$GET(^GMR(120.8,NUM,"ER"))

                   SET ERR=1

               IF ERR

                   QUIT 

 +4        QUIT ERR