- 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 Mar 13, 2025@20:44:37 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
