MCARGEA ;WISC/MLH-GI ENTER/EDIT-DISPLAY ALLERGY INFO ;7/12/00 11:53
;;2.3;Medicine;**28**;09/13/1996
;
IF '$D(^DIC(120.8)) D Q ;display allergy info from patient file
. S DIC="^DPT(",DR="PA"
. D EN^DIQ
. K DIC,DR
. Q
; display allergy info from new allergy pkg [RM-MLH]
W !!,"Allergies/Adverse Reactions:"
N DFN K GMRAL S DFN=$P($G(^MCAR(699,MCARGDA,0)),U,2) D ^GMRADPT
I $G(GMRAL)=1 D
. N MCAR,MCAR0 F MCAR=0:0 S MCAR=$O(GMRAL(MCAR)) Q:MCAR'>0 W:$X>5 ! W ?5,$P(GMRAL(MCAR),U,2) F MCAR1=0:0 S MCAR1=$O(^GMR(120.8,MCAR,10,MCAR1)) Q:MCAR1'>0 W:$X>35 ! W ?35,$$RXN(MCAR,MCAR1)
. W !
. K GMRAL
. Q
E W ?35,$S($G(GMRAL)=0:"NKA",1:""),!
QUIT
;
RXN(X,Y) ; FUNCTION WHOSE VALUE IS PRINTABLE RXN IN ENTRY ^GMR(120.8,X,10,Y,0) [RM-MLH]
N MCAR,MCAR1 S MCAR=$G(^GMR(120.8,X,10,Y,0)),MCAR1=$P(MCAR,U)
Q $S('MCAR1:"",MCAR1'=$O(^GMRD(120.83,"B","OTHER REACTION",0)):$P($G(^GMRD(120.83,MCAR1,0)),U),1:$P(MCAR,U,2))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARGEA 958 printed Dec 13, 2024@02:12:55 Page 2
MCARGEA ;WISC/MLH-GI ENTER/EDIT-DISPLAY ALLERGY INFO ;7/12/00 11:53
+1 ;;2.3;Medicine;**28**;09/13/1996
+2 ;
+3 ;display allergy info from patient file
IF '$DATA(^DIC(120.8))
Begin DoDot:1
+4 SET DIC="^DPT("
SET DR="PA"
+5 DO EN^DIQ
+6 KILL DIC,DR
+7 QUIT
End DoDot:1
QUIT
+8 ; display allergy info from new allergy pkg [RM-MLH]
+9 WRITE !!,"Allergies/Adverse Reactions:"
+10 NEW DFN
KILL GMRAL
SET DFN=$PIECE($GET(^MCAR(699,MCARGDA,0)),U,2)
DO ^GMRADPT
+11 IF $GET(GMRAL)=1
Begin DoDot:1
+12 NEW MCAR,MCAR0
FOR MCAR=0:0
SET MCAR=$ORDER(GMRAL(MCAR))
if MCAR'>0
QUIT
if $X>5
WRITE !
WRITE ?5,$PIECE(GMRAL(MCAR),U,2)
FOR MCAR1=0:0
SET MCAR1=$ORDER(^GMR(120.8,MCAR,10,MCAR1))
if MCAR1'>0
QUIT
if $X>35
WRITE !
WRITE ?35,$$RXN(MCAR,MCAR1)
+13 WRITE !
+14 KILL GMRAL
+15 QUIT
End DoDot:1
+16 IF '$TEST
WRITE ?35,$SELECT($GET(GMRAL)=0:"NKA",1:""),!
+17 QUIT
+18 ;
RXN(X,Y) ; FUNCTION WHOSE VALUE IS PRINTABLE RXN IN ENTRY ^GMR(120.8,X,10,Y,0) [RM-MLH]
+1 NEW MCAR,MCAR1
SET MCAR=$GET(^GMR(120.8,X,10,Y,0))
SET MCAR1=$PIECE(MCAR,U)
+2 QUIT $SELECT('MCAR1:"",MCAR1'=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0)):$PIECE($GET(^GMRD(120.83,MCAR1,0)),U),1:$PIECE(MCAR,U,2))
