- 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 Jan 18, 2025@03:14:07 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))