MCARGEA.m

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 ---MCARGEA   958     printed  Apr 09, 2024@21:19:33                                                                                                                                                                                                      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))