| [613] | 1 | PSBALL ;BIRMINGHAM/VRN-BCMA RPC BROKER CALLS ;Mar 2004
 | 
|---|
 | 2 |  ;;3.0;BAR CODE MED ADMIN;;Mar 2004
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  ; Reference/IA
 | 
|---|
 | 5 |  ; EN1^GMRADPT/10099
 | 
|---|
 | 6 |  ;
 | 
|---|
 | 7 | ALLR(RESULTS,DFN) ; Return array of patient allergies/adverse reactions
 | 
|---|
 | 8 |  ;
 | 
|---|
 | 9 |  ;RPC: PSB ALLERGY
 | 
|---|
 | 10 |  ;
 | 
|---|
 | 11 |  D SORT
 | 
|---|
 | 12 |  Q
 | 
|---|
 | 13 |  ;
 | 
|---|
 | 14 | SORT ;*** Set up the allergies and adv. reactions arrays.
 | 
|---|
 | 15 |  S PSBCNT=1,(PSBALC,PSBARC)=0
 | 
|---|
 | 16 |  S GMRA="0^0^111" D EN1^GMRADPT
 | 
|---|
 | 17 |  I GMRAL="" S RESULTS(0)=1,RESULTS(1)="ALL"_U_"No Allergy Assessment" Q
 | 
|---|
 | 18 |  I GMRAL=0 S RESULTS(0)=1,RESULTS(1)="ALL"_U_"No Known Allergies" Q
 | 
|---|
 | 19 |  F X=0:0 S X=$O(GMRAL(X)) Q:'X  S PSBTYP=$P(GMRAL(X),U,5),PSBNM=$P(GMRAL(X),U,2) D
 | 
|---|
 | 20 |  .S:PSBTYP=0 PSBALC=PSBALC+1,PSBALG(PSBNM)=""
 | 
|---|
 | 21 |  .S:PSBTYP>0 PSBARC=PSBARC+1,PSBADR(PSBNM)=""
 | 
|---|
 | 22 |  S (X,Y)="" F  S X=$O(PSBALG(X)) Q:X=""  S Y="ALL"_U_X,RESULTS(PSBCNT)=Y,PSBCNT=PSBCNT+1
 | 
|---|
 | 23 |  S (X,Y)="" F  S X=$O(PSBADR(X)) Q:X=""  S Y="ADR"_U_X,RESULTS(PSBCNT)=Y,PSBCNT=PSBCNT+1
 | 
|---|
 | 24 |  S RESULTS(0)=PSBCNT-1
 | 
|---|
 | 25 |  K GMRA,GMRAL,PSBADR,PSBALC,PSBALG,PSBARC,PSBCNT,PSBNM,PSBTYP
 | 
|---|
 | 26 |  Q
 | 
|---|
 | 27 |  ;
 | 
|---|