APSPGMR.m

APSPGMR ; IHS/DSD/ENM - Patient Allergy Lookup ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

EP ;EP - Entry point from APSPDSC1

 S DFN=PSODFN D GMRA

 Q

GMRA K ^TMP($J,"AL") S GMRA="0^1^111" D ^GMRADPT I GMRAL D

 .F DR=0:0 S DR=$O(GMRAL(DR)) Q:'DR  S ^TMP($J,"AL",$S('$P($P(GMRAL(DR),"^",6),";",2):1,1:2),$P(GMRAL(DR),"^",3),$P(GMRAL(DR),"^",2))=""

 .W !!,"ALLERGIES: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",1,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?11 W DR_", "

 .;IHS/DSD/ENM 3.9.95 ESCAPE CODES ADDED TO NEXT LINE

 .;W !!,$C(27)_"[7m"_$C(27)_"[5m"_"ALLERGIES: "_$C(27)_"[m" S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",1,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?11 W DR_", "

 .;W !!,$C(27)_"[7m"_$C(27)_"[5m"_"ADVERSE REACTIONS: "_$C(27)_"[m" S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",2,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?19 W DR_", "

 .W !!,"ADVERSE REACTIONS: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",2,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?19 W DR_", "

 I $G(GMRAL)']"" F AD="ALLERGIES:","ADVERSE REACTIONS:" W !!,AD I $G(PSOFROM)="" F ADL=1:1:IOM-($L(AD)+5) W "_"

 I GMRAL=0 W !!,"ALLERGIES: NKA",!!,"ADVERSE REACTIONS:"

 W ! K TY,D,GMRA,GMRAL,DR,AD,ADL,^TMP($J,"AL") Q

APSPGMR   ; IHS/DSD/ENM - Patient Allergy Lookup ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

EP        ;EP - Entry point from APSPDSC1

 +1        SET DFN=PSODFN

           DO GMRA

 +2        QUIT 

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

           SET GMRA="0^1^111"

           DO ^GMRADPT

           IF GMRAL

               Begin DoDot:1

 +1                FOR DR=0:0

                       SET DR=$ORDER(GMRAL(DR))

                       IF 'DR

                           QUIT 

                       SET ^TMP($JOB,"AL",$SELECT('$PIECE($PIECE(GMRAL(DR),"^",6),";",2):1,1:2),$PIECE(GMRAL(DR),"^",3),$PIECE(GMRAL(DR),"^",2))=""

 +2                WRITE !!,"ALLERGIES: "

                   SET (DR,TY)=""

                   FOR I=0:0

                       SET TY=$ORDER(^TMP($JOB,"AL",1,TY))

                       IF TY=""

                           QUIT 

                       FOR D=0:0

                           SET DR=$ORDER(^TMP($JOB,"AL",1,TY,DR))

                           IF DR=""

                               QUIT 

                           IF $X+$LENGTH(DR)+$LENGTH(", ")>IOM

                               WRITE !?11

                           WRITE DR_", "

 +3       ;IHS/DSD/ENM 3.9.95 ESCAPE CODES ADDED TO NEXT LINE

 +4       ;W !!,$C(27)_"[7m"_$C(27)_"[5m"_"ALLERGIES: "_$C(27)_"[m" S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",1,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?11 W DR_", "

 +5       ;W !!,$C(27)_"[7m"_$C(27)_"[5m"_"ADVERSE REACTIONS: "_$C(27)_"[m" S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",2,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?19 W DR_", "

 +6                WRITE !!,"ADVERSE REACTIONS: "

                   SET (DR,TY)=""

                   FOR I=0:0

                       SET TY=$ORDER(^TMP($JOB,"AL",2,TY))

                       IF TY=""

                           QUIT 

                       FOR D=0:0

                           SET DR=$ORDER(^TMP($JOB,"AL",2,TY,DR))

                           IF DR=""

                               QUIT 

                           IF $X+$LENGTH(DR)+$LENGTH(", ")>IOM

                               WRITE !?19

                           WRITE DR_", "

               End DoDot:1

 +7        IF $GET(GMRAL)']""

               FOR AD="ALLERGIES:","ADVERSE REACTIONS:"

                   WRITE !!,AD

                   IF $GET(PSOFROM)=""

                       FOR ADL=1:1:IOM-($LENGTH(AD)+5)

                           WRITE "_"

 +8        IF GMRAL=0

               WRITE !!,"ALLERGIES: NKA",!!,"ADVERSE REACTIONS:"

 +9        WRITE !

           KILL TY,D,GMRA,GMRAL,DR,AD,ADL,^TMP($JOB,"AL")

           QUIT