source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARGPA.m@ 1484

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

initial load of WorldVistAEHR

File size: 884 bytes
Line 
1MCARGPA ;WISC/MLH-PRINT ALLERGY INFO ON 'MCAROGH' PRINT TEMPLATE ;7/12/00 11:46
2 ;;2.3;Medicine;**28**;09/13/1996
3 X "N DFN K GMRAL S DFN=$P($G(^MCAR(699,MCARGDA,0)),U,2) D ^GMRADPT"
4 I $G(GMRAL)=1 D
5 . X "N MCAR,MCAR0 F MCAR=0:0 S MCAR=$O(GMRAL(MCAR)) Q:MCAR'>0!'DN D N:$X>5 Q:'DN W ?5,$P(GMRAL(MCAR),U,2) F MCAR1=0:0 S MCAR1=$O(^GMR(120.8,MCAR,10,MCAR1)) Q:MCAR1'>0 D:$X>35 N Q:'DN W ?35,$$RXN(MCAR,MCAR1)"
6 . K GMRAL
7 . QUIT
8 E W ?35,$S($G(GMRAL)=0:"NKA",1:""),!
9 Q
10 ;
11RXN(X,Y) ; FUNCTION WHOSE VALUE IS PRINTABLE RXN IN ENTRY ^GMR(120.8,X,10,Y,0)
12 N MCAR,MCAR1 S MCAR=$G(^GMR(120.8,X,10,Y,0)),MCAR1=$P(MCAR,U)
13 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))
14 ;
15N W !
16T W:$X ! I '$D(DIOT(2)),DN,$D(IOSL),$S('$D(DIWF):1,$P(DIWF,"B",2):$P(DIWF,"B",2),1:1)+$Y'<IOSL,$D(^UTILITY($J,1))#2,^(1)?1U1P1E.E X ^(1)
17 Q
Note: See TracBrowser for help on using the repository browser.