PSBALL ;BIRMINGHAM/VRN-BCMA RPC BROKER CALLS ;04/22/16 14:14
;;3.0;BAR CODE MED ADMIN;**93**;Mar 2004;Build 111
;
; Reference/IA
; EN1^GMRADPT/10099
; EN2^GMRADPT/10099 ;93
; HAVEHDR^ORRDI1/4659 ;93
;
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.
N REMOTE,GMRA,GMRAL,PSBLCL,REMALL,REMADR,PSBALL,PSBADR,PSBCNT,PSBNM,PSBTYP,X,FIRST
S PSBCNT=0
S GMRA="0^0^111" D EN2^GMRADPT ; local results only
S PSBLCL=GMRAL ; needed to know nka/no assesment (if there are remote results but not local results)
S GMRA="0^0^111^1" D EN2^GMRADPT ; include remote
S REMOTE=$$HAVEHDR^ORRDI1 ;check if server is up
I +GMRAL D ; found local and/or remote results
.S X="" F S X=$O(GMRAL(X)) Q:X="" D ; seperate into 4 arrays local allergies, local adrs, remote allergies, remote adrs
..S PSBTYP=$P(GMRAL(X),U,5),PSBNM=$P(GMRAL(X),U,2)
..I X["R" D Q
...S:PSBTYP=0 REMALL(PSBNM)=""
...S:PSBTYP>0 REMADR(PSBNM)=""
..S:PSBTYP=0 PSBALL(PSBNM)=""
..S:PSBTYP>0 PSBADR(PSBNM)=""
.; add allergies first
.I '$D(PSBALL) S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ALL"_U_$S(PSBLCL="":"No Assessment",1:"No Known Allergies")
.I $D(PSBALL) S X="" F S X=$O(PSBALL(X)) Q:X="" S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ALL"_U_X ; add local allergies
.S RESULTS(PSBCNT)=RESULTS(PSBCNT)_" Remote Allergies: " ; add remote tag to last local allergy
.I '$D(REMALL) D ; no remote allergies
..I '$D(REMADR),'REMOTE S RESULTS(PSBCNT)=RESULTS(PSBCNT)_"Remote Data Not Available" Q
..S RESULTS(PSBCNT)=RESULTS(PSBCNT)_"None"
.I $D(REMALL) S X="",FIRST=1 F S X=$O(REMALL(X)) Q:X="" D
..I 'FIRST S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ALL"_U_X ; add remote allergies to list (will quit if none found)
..I FIRST S RESULTS(PSBCNT)=RESULTS(PSBCNT)_X,FIRST=0 ; first one needs to be appended to avoid leading comma added in gui
.; add adrs next
.I '$D(PSBADR) S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ADR"_U_$S(PSBLCL="":"No Assessment",1:"No Known Reactions")
.I $D(PSBADR) S X="" F S X=$O(PSBADR(X)) Q:X="" S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ADR"_U_X ; add local adrs
.S RESULTS(PSBCNT)=RESULTS(PSBCNT)_" Remote ADRs: " ; add remote tag to last local adr
.I '$D(REMADR) D ; no remote adrs
..I '$D(REMALL),REMOTE'>0 S RESULTS(PSBCNT)=RESULTS(PSBCNT)_"Remote Data Not Available" Q
..S RESULTS(PSBCNT)=RESULTS(PSBCNT)_"None"
.I $D(REMADR) S X="",FIRST=1 F S X=$O(REMADR(X)) Q:X="" D
..I 'FIRST S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ADR"_U_X ; add remote adrs to list (will quit if none found)
..I FIRST S RESULTS(PSBCNT)=RESULTS(PSBCNT)_X,FIRST=0 ; first one needs to be appended to avoid leading comma added in gui
E D ; did not find local or remote results
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ALL"_U_$S(PSBLCL="":"No Assessment",1:"No Known Allergies")
.S RESULTS(PSBCNT)=RESULTS(PSBCNT)_$S('REMOTE:" Remote: Remote Data Not Available",1:" Remote Allergies: None")
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="ADR"_U_$S(PSBLCL="":"No Assessment",1:"No Known Reactions")
.S RESULTS(PSBCNT)=RESULTS(PSBCNT)_$S('REMOTE:" Remote: Remote Data Not Available",1:" Remote ADRs: None")
S RESULTS(0)=PSBCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBALL 3280 printed Sep 23, 2025@19:15:56 Page 2
PSBALL ;BIRMINGHAM/VRN-BCMA RPC BROKER CALLS ;04/22/16 14:14
+1 ;;3.0;BAR CODE MED ADMIN;**93**;Mar 2004;Build 111
+2 ;
+3 ; Reference/IA
+4 ; EN1^GMRADPT/10099
+5 ; EN2^GMRADPT/10099 ;93
+6 ; HAVEHDR^ORRDI1/4659 ;93
+7 ;
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 NEW REMOTE,GMRA,GMRAL,PSBLCL,REMALL,REMADR,PSBALL,PSBADR,PSBCNT,PSBNM,PSBTYP,X,FIRST
+2 SET PSBCNT=0
+3 ; local results only
SET GMRA="0^0^111"
DO EN2^GMRADPT
+4 ; needed to know nka/no assesment (if there are remote results but not local results)
SET PSBLCL=GMRAL
+5 ; include remote
SET GMRA="0^0^111^1"
DO EN2^GMRADPT
+6 ;check if server is up
SET REMOTE=$$HAVEHDR^ORRDI1
+7 ; found local and/or remote results
IF +GMRAL
Begin DoDot:1
+8 ; seperate into 4 arrays local allergies, local adrs, remote allergies, remote adrs
SET X=""
FOR
SET X=$ORDER(GMRAL(X))
if X=""
QUIT
Begin DoDot:2
+9 SET PSBTYP=$PIECE(GMRAL(X),U,5)
SET PSBNM=$PIECE(GMRAL(X),U,2)
+10 IF X["R"
Begin DoDot:3
+11 if PSBTYP=0
SET REMALL(PSBNM)=""
+12 if PSBTYP>0
SET REMADR(PSBNM)=""
End DoDot:3
QUIT
+13 if PSBTYP=0
SET PSBALL(PSBNM)=""
+14 if PSBTYP>0
SET PSBADR(PSBNM)=""
End DoDot:2
+15 ; add allergies first
+16 IF '$DATA(PSBALL)
SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ALL"_U_$SELECT(PSBLCL="":"No Assessment",1:"No Known Allergies")
+17 ; add local allergies
IF $DATA(PSBALL)
SET X=""
FOR
SET X=$ORDER(PSBALL(X))
if X=""
QUIT
SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ALL"_U_X
+18 ; add remote tag to last local allergy
SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_" Remote Allergies: "
+19 ; no remote allergies
IF '$DATA(REMALL)
Begin DoDot:2
+20 IF '$DATA(REMADR)
IF 'REMOTE
SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_"Remote Data Not Available"
QUIT
+21 SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_"None"
End DoDot:2
+22 IF $DATA(REMALL)
SET X=""
SET FIRST=1
FOR
SET X=$ORDER(REMALL(X))
if X=""
QUIT
Begin DoDot:2
+23 ; add remote allergies to list (will quit if none found)
IF 'FIRST
SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ALL"_U_X
+24 ; first one needs to be appended to avoid leading comma added in gui
IF FIRST
SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_X
SET FIRST=0
End DoDot:2
+25 ; add adrs next
+26 IF '$DATA(PSBADR)
SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ADR"_U_$SELECT(PSBLCL="":"No Assessment",1:"No Known Reactions")
+27 ; add local adrs
IF $DATA(PSBADR)
SET X=""
FOR
SET X=$ORDER(PSBADR(X))
if X=""
QUIT
SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ADR"_U_X
+28 ; add remote tag to last local adr
SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_" Remote ADRs: "
+29 ; no remote adrs
IF '$DATA(REMADR)
Begin DoDot:2
+30 IF '$DATA(REMALL)
IF REMOTE'>0
SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_"Remote Data Not Available"
QUIT
+31 SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_"None"
End DoDot:2
+32 IF $DATA(REMADR)
SET X=""
SET FIRST=1
FOR
SET X=$ORDER(REMADR(X))
if X=""
QUIT
Begin DoDot:2
+33 ; add remote adrs to list (will quit if none found)
IF 'FIRST
SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ADR"_U_X
+34 ; first one needs to be appended to avoid leading comma added in gui
IF FIRST
SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_X
SET FIRST=0
End DoDot:2
End DoDot:1
+35 ; did not find local or remote results
IF '$TEST
Begin DoDot:1
+36 SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ALL"_U_$SELECT(PSBLCL="":"No Assessment",1:"No Known Allergies")
+37 SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_$SELECT('REMOTE:" Remote: Remote Data Not Available",1:" Remote Allergies: None")
+38 SET PSBCNT=PSBCNT+1
SET RESULTS(PSBCNT)="ADR"_U_$SELECT(PSBLCL="":"No Assessment",1:"No Known Reactions")
+39 SET RESULTS(PSBCNT)=RESULTS(PSBCNT)_$SELECT('REMOTE:" Remote: Remote Data Not Available",1:" Remote ADRs: None")
End DoDot:1
+40 SET RESULTS(0)=PSBCNT
+41 QUIT
