source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARGEA.m@ 1036

Last change on this file since 1036 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 936 bytes
RevLine 
[613]1MCARGEA ;WISC/MLH-GI ENTER/EDIT-DISPLAY ALLERGY INFO ;7/12/00 11:53
2 ;;2.3;Medicine;**28**;09/13/1996
3 ;
4 IF '$D(^DIC(120.8)) D Q ;display allergy info from patient file
5 . S DIC="^DPT(",DR="PA"
6 . D EN^DIQ
7 . K DIC,DR
8 . Q
9 ; display allergy info from new allergy pkg [RM-MLH]
10 W !!,"Allergies/Adverse Reactions:"
11 N DFN K GMRAL S DFN=$P($G(^MCAR(699,MCARGDA,0)),U,2) D ^GMRADPT
12 I $G(GMRAL)=1 D
13 . 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)
14 . W !
15 . K GMRAL
16 . Q
17 E W ?35,$S($G(GMRAL)=0:"NKA",1:""),!
18 QUIT
19 ;
20RXN(X,Y) ; FUNCTION WHOSE VALUE IS PRINTABLE RXN IN ENTRY ^GMR(120.8,X,10,Y,0) [RM-MLH]
21 N MCAR,MCAR1 S MCAR=$G(^GMR(120.8,X,10,Y,0)),MCAR1=$P(MCAR,U)
22 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))
Note: See TracBrowser for help on using the repository browser.