| 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 | ;
|
|---|
