source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBALL.m@ 1361

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

initial load of WorldVistAEHR

File size: 949 bytes
RevLine 
[613]1PSBALL ;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 ;
7ALLR(RESULTS,DFN) ; Return array of patient allergies/adverse reactions
8 ;
9 ;RPC: PSB ALLERGY
10 ;
11 D SORT
12 Q
13 ;
14SORT ;*** 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 ;
Note: See TracBrowser for help on using the repository browser.