28 lines
949 B
Mathematica
28 lines
949 B
Mathematica
PSBALL ;BIRMINGHAM/VRN-BCMA RPC BROKER CALLS ;Mar 2004
|
|
;;3.0;BAR CODE MED ADMIN;;Mar 2004
|
|
;
|
|
; Reference/IA
|
|
; EN1^GMRADPT/10099
|
|
;
|
|
ALLR(RESULTS,DFN) ; Return array of patient allergies/adverse reactions
|
|
;
|
|
;RPC: PSB ALLERGY
|
|
;
|
|
D SORT
|
|
Q
|
|
;
|
|
SORT ;*** Set up the allergies and adv. reactions arrays.
|
|
S PSBCNT=1,(PSBALC,PSBARC)=0
|
|
S GMRA="0^0^111" D EN1^GMRADPT
|
|
I GMRAL="" S RESULTS(0)=1,RESULTS(1)="ALL"_U_"No Allergy Assessment" Q
|
|
I GMRAL=0 S RESULTS(0)=1,RESULTS(1)="ALL"_U_"No Known Allergies" Q
|
|
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
|
|
.S:PSBTYP=0 PSBALC=PSBALC+1,PSBALG(PSBNM)=""
|
|
.S:PSBTYP>0 PSBARC=PSBARC+1,PSBADR(PSBNM)=""
|
|
S (X,Y)="" F S X=$O(PSBALG(X)) Q:X="" S Y="ALL"_U_X,RESULTS(PSBCNT)=Y,PSBCNT=PSBCNT+1
|
|
S (X,Y)="" F S X=$O(PSBADR(X)) Q:X="" S Y="ADR"_U_X,RESULTS(PSBCNT)=Y,PSBCNT=PSBCNT+1
|
|
S RESULTS(0)=PSBCNT-1
|
|
K GMRA,GMRAL,PSBADR,PSBALC,PSBALG,PSBARC,PSBCNT,PSBNM,PSBTYP
|
|
Q
|
|
;
|