- 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
- ;
- PSBALL ;BIRMINGHAM/VRN-BCMA RPC BROKER CALLS ;Mar 2004
- +1 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
- +2 ;
- +3 ; Reference/IA
- +4 ; EN1^GMRADPT/10099
- +5 ;
- ALLR(RESULTS,DFN) ; Return array of patient allergies/adverse reactions
- +1 ;
- +2 ;RPC: PSB ALLERGY
- +3 ;
- +4 DO SORT
- +5 QUIT
- +6 ;
- SORT ;*** Set up the allergies and adv. reactions arrays.
- +1 SET PSBCNT=1
- SET (PSBALC,PSBARC)=0
- +2 SET GMRA="0^0^111"
- DO EN1^GMRADPT
- +3 IF GMRAL=""
- SET RESULTS(0)=1
- SET RESULTS(1)="ALL"_U_"No Allergy Assessment"
- QUIT
- +4 IF GMRAL=0
- SET RESULTS(0)=1
- SET RESULTS(1)="ALL"_U_"No Known Allergies"
- QUIT
- +5 FOR X=0:0
- SET X=$ORDER(GMRAL(X))
- IF 'X
- QUIT
- SET PSBTYP=$PIECE(GMRAL(X),U,5)
- SET PSBNM=$PIECE(GMRAL(X),U,2)
- Begin DoDot:1
- +6 IF PSBTYP=0
- SET PSBALC=PSBALC+1
- SET PSBALG(PSBNM)=""
- +7 IF PSBTYP>0
- SET PSBARC=PSBARC+1
- SET PSBADR(PSBNM)=""
- End DoDot:1
- +8 SET (X,Y)=""
- FOR
- SET X=$ORDER(PSBALG(X))
- IF X=""
- QUIT
- SET Y="ALL"_U_X
- SET RESULTS(PSBCNT)=Y
- SET PSBCNT=PSBCNT+1
- +9 SET (X,Y)=""
- FOR
- SET X=$ORDER(PSBADR(X))
- IF X=""
- QUIT
- SET Y="ADR"_U_X
- SET RESULTS(PSBCNT)=Y
- SET PSBCNT=PSBCNT+1
- +10 SET RESULTS(0)=PSBCNT-1
- +11 KILL GMRA,GMRAL,PSBADR,PSBALC,PSBALG,PSBARC,PSBCNT,PSBNM,PSBTYP
- +12 QUIT
- +13 ;