PSOERALL ;ALB/MR - eRx Patient Allergies ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
EN ; -- main entry point for PSO ERX HOLDING QUEUE
N LASTLINE,MBMSITE
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
; Call from a Pending Order
I '$G(PSOIEN),$G(ORD),$D(^PS(52.41,ORD,0)) N PSOIEN S PSOIEN=+$$ERXIEN^PSOERXUT(ORD_"P")
I '$G(PSOIEN) D Q
. S VALMSG="This is not an eRx prescription",VALMBCK="R" W $C(7)
S ERXIEN=PSOIEN
D EN^VALM("PSO ERX PATIENT ALLERGIES")
Q
;
LMHDR ; ListMan Header Code
D SHOW^VALM,HDR^PSOERALL
S XQORM("??")="D HELP^VALM2,HDR^PSOERALL"
Q
;
HDR ; -- header code
N AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
S AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.6,"I"),VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
S VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.13,"E"),VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.14,"I")
S VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM
;Only Displays Eligibility info if VistA Patient is selected
I $G(VPATIEN) D
. D INSTR^VALM1($S($G(MBMSITE):"ChampVA Rx Benefit: ",1:"Eligibility: ")_IOINHI_$$ELIG^PSOERXP1(VPATIEN)_IOINORM,$S($G(MBMSITE):41,1:30),2)
S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPATIEN:"MANUALLY-MATCHED",1:"")
I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
I MATCH="" S MATCH="NOT MATCHED"
S $E(MATCH,81)="" D INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)
S HDR="",$E(HDR,15)="ERX PATIENT",$E(HDR,40)="|",$E(HDR,54)="VISTA PATIENT"
S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)
Q
;
INIT ;
N ERXPAT,PSODFN,DFN,XE,XV,DATA,ERXDM,ERR,ERXNAME,ERXDOB,ERXSSN,VADM,VAPA,VANAME,VADOB,VASSN
N HIGHLN,REVLN,UNDERLN,BLINKLN,HIGUNDLN
;
S NMSPC="PSOERALL"
; Required variable: PSOIEN - Pointer to ERX HOLDING QUEUE (#52.49)
I '$G(PSOIEN) Q
S ERXPAT=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
S (DFN,PSODFN)=+$$VISTAPAT^PSOERUT6(PSOIEN)
;
K ^TMP("PSOERALL",$J)
;eRx Patient Data
D GETS^DIQ(52.46,ERXPAT_",",".01;.08;1.4","EI","DATA","ERR")
M ERXDM=DATA(52.46,ERXPAT_",")
S ERXNAME=$E(ERXDM(.01,"E"),1,33),ERXDOB=ERXDM(.08,"E"),ERXSSN=ERXDM(1.4,"E")
;VistA Patient Data
S (VANAME,VADOB,VASSN)=""
I DFN D
. D DEM^VADPT,ADD^VADPT
. S VANAME=$E($P(VADM(1),"^"),1,33),VADOB=$P(VADM(3),"^",2),VASSN=$P(VADM(2),"^",2)
;
; - Resetting list to NORMAL video attributes
D RESET^PSOERUT0()
;
S LINE=1
S XE="Name: "_$$COMPARE^PSOERUT0("LM",$E(ERXNAME,1,33),$G(VANAME),7)
S XV="|Name: "_$$COMPARE^PSOERUT0("LM",$G(VANAME),ERXNAME,47)
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
I $L(ERXNAME)>33 D
. S XE=$$COMPARE^PSOERUT0("LM",$E(ERXNAME,34,99),"",7)
. D ADDLINE^PSOERUT0("LM",NMSPC,XE,"|")
S XE="DOB : "_$$COMPARE^PSOERUT0("LM",ERXDOB,$G(VADOB),7)
S XV="|DOB : "_$$COMPARE^PSOERUT0("LM",$G(VADOB),ERXDOB,47)
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
S XE="SSN : "_$$COMPARE^PSOERUT0("LM",ERXSSN,VASSN,7)
S XV="|SSN : "_$$COMPARE^PSOERUT0("LM",VASSN,ERXSSN,47)
D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
;
D BLANKLN^PSOERUT0("LM")
D ALLERGY(PSOIEN,DFN)
D BLANKLN^PSOERUT0("LM")
;
S VALMCNT=LINE-1
; - Saving NORMAL video attributes to be reset later
I LINE>$G(LASTLINE) D
. F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
. S LASTLINE=LINE
D VIDEO^PSOERUT0()
Q
;
HELP ; -- help code
;S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D FULL^VALM1
Q
;
EXPND ; -- expand code
Q
;
VPA ; Vista Patient Allergies
N DFN,PSODFN
I '$G(PSOIEN) Q
S (DFN,PSODFN)=+$$GET1^DIQ(52.49,PSOIEN,.05,"I")
I '$G(DFN) S VALMSG="No VistA Patient Selected (Not Matched).",VALMBCK="R" W $C(7) Q
D ^PSOORUT2,EN^PSOLMDA
D INIT S VALMBCK="R"
Q
;
ALLERGY(ERXIEN,DFN) ; VistA Patient Allergy and Adverse Reaction information
; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; DFN - Pointer to PATIENT File(#2)
;
N IEN,XE,XV,LDAT,GMRA,GMRAL,PSONOAL,LN,TYPE,VANOASS,VANKA,EALLDATA,ALLLN,SEQ,SEV,DRUGFOOD,SYMP,SYMPS
N ALL,Z,ZH,VERIFY,TYPE,AGENT,FILE,ERXALL,ALLLIST,ORIGDTTM,SEVERITY,VERIFY,OBSHIST,ALLINFO,LN,SEVER
N SEVERS,UPPERLN,ERXALLS,VAALLS,ERXNKA
S (VANOASS,VANKA)=0
;
; Loading VistA Allergies and Building array VAALLS for comparison
I $G(DFN) D
. ; Local Allergies
. S GMRA="0^0^111^1^0" D ^GMRADPT
. I GMRAL="" S VANOASS=1 ; No Allergy Assessment
. I GMRAL=0 S VANKA=1 ; No Known Allergies
. I GMRAL D
. . S ALL=0 F S ALL=$O(GMRAL(ALL)) Q:'ALL I $P($G(GMRAL(ALL)),"^",2)'="" S VAALLS($P(GMRAL(ALL),"^",2))=""
. ; Remote Allergies
. I $T(HAVEHDR^ORRDI1)'="",$$HAVEHDR^ORRDI1,$D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D
. . D GET^ORRDI1(DFN,"ART") D
. . I $P($G(^XTMP("ORRDI","ART",DFN,0)),"^",3)=0 Q
. . S ALL=0 F S ALL=$O(^XTMP("ORRDI","ART",DFN,ALL)) Q:'ALL D
. . . S AGENT=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"REACTANT",0)),"^",1) I AGENT="" Q
. . . S VAALLS(AGENT)=""
;
; Loading VistA Allergies and Building array ERXALLS for comparison
S ALLLN=LINE-1
S ALLLN=ALLLN+1,ERXALL(ALLLN)="Allergy:"
S ERXNKA=$$GET1^DIQ(52.49,ERXIEN,302,"I")
I ERXNKA="Y" D
. S ALLLN=ALLLN+1,ERXALL(ALLLN)=" NO KNOWN ALLERGIES"
. I VANKA S HIGHLN(ALLLN,2)=18
. E S REVLN(ALLLN,2)=18
D ALRGDATA^PSOERXU9(.EALLDATA,ERXIEN,1)
I ERXNKA'="Y",'$O(EALLDATA(0)) D
. S ALLLN=ALLLN+1,ERXALL(ALLLN)=" NO ALLERGY INFORMATION RECEIVED"
. I VANOASS S HIGHLN(ALLLN,2)=31
. E S REVLN(ALLLN,2)=31
S SEQ=0 F S SEQ=$O(EALLDATA(SEQ)) Q:'SEQ D
. I $P($G(EALLDATA(SEQ)),"^",7)'="" S ERXALLS($P(EALLDATA(SEQ),"^",7))=""
;
; Bulding Screen with eRx Allergies (Left Side)
S SEQ=0
F S SEQ=$O(EALLDATA(SEQ)) Q:'SEQ D
. S Z=$G(EALLDATA(SEQ)),AGENT=$P(Z,"^",7)
. F Q:$G(AGENT)="" D
. . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" "_$E(AGENT,1,38)
. . I $D(VAALLS($P(Z,"^",7))) S HIGUNDLN(ALLLN,2)=$S($L(AGENT)>38:38,1:$L(AGENT))
. . E S REVLN(ALLLN,2)=$S($L(AGENT)>38:38,1:$L(AGENT))
. . S AGENT=$E(AGENT,39,999)
. I $P(Z,"^",3) D
. . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Effective Date: "_$$FMTE^XLFDT($P(Z,"^",3))
. . S HIGHLN(ALLLN,20)=12
. S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Severity: "
. D ADDFRTXT($P(Z,"^",10),0,35,.ERXALL,.ALLLN," ","5^35")
. I $P(Z,"^",8)'="" D
. . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Reaction: "
. . D ADDFRTXT($P(Z,"^",8),0,35,.ERXALL,.ALLLN," ","5^35")
. S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Symptoms: "
. D ADDFRTXT($P(Z,"^",12),0,35,.ERXALL,.ALLLN," ","5^35")
;
; Gathering Local VistA Allergies Details
K ALLLIST,REF
I $G(DFN) D
. I GMRAL D ; Allergies Found
. . S ALL=0 F S ALL=$O(GMRAL(ALL)) Q:'ALL D
. . . S Z=GMRAL(ALL),ZH=$G(GMRAL(ALL,"H"))
. . . K ALLINFO D EN1^GMRAOR2(ALL,"ALLINFO")
. . . S AGENT=$P(ALLINFO,"^",1),VERIFY=$$TITLE^XLFSTR($P(ALLINFO,"^",4)),OBSHIST=$P(ALLINFO,"^",5)
. . . S TYPE=$S($P(ALLINFO,"^",6)="ALLERGY":"1^Allergy",1:"2^Adverse Reaction")
. . . S DRUGFOOD=$$TITLE^XLFSTR($P(ALLINFO,"^",7)),DRUGFOOD=$TR(DRUGFOOD," "),DRUGFOOD=$TR(DRUGFOOD,",","/")
. . . S ORIGDTTM=$P(ALLINFO,"^",10)
. . . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ")=AGENT_"^"_ORIGDTTM_"^"_OBSHIST
. . . S SEVERITY=""
. . . I $D(ALLINFO("H")) S SEVERITY=$P($G(ALLINFO("H")),"^",2)
. . . I $D(ALLINFO("O")) S SEV=$O(ALLINFO("O",0)) I SEV S SEVERITY=$P($G(ALLINFO("O",SEV)),"^",2)
. . . S:(SEVERITY'="") ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","O")=SEVERITY
. . . S (SYMP,SYMPS)="" F S SYMP=$O(ALLINFO("S",SYMP)) Q:SYMP="" D
. . . . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","S",$G(ALLINFO("S",SYMP))_" ")=""
;
; Gathering Remote VistA Allergies
I $G(DFN) D
. S ALL=0 F S ALL=$O(^XTMP("ORRDI","ART",DFN,ALL)) Q:'ALL D
. . S Z=$G(^XTMP("ORRDI","ART",DFN,ALL,"GMRALLERGY",0))
. . S FILE=$P($P(Z,"^",3),"99VA",2)
. . I FILE'=50.6,FILE'=120.82,FILE'=50.605,FILE'=50.416 Q
. . S AGENT=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"REACTANT",0)),"^",1)
. . S TYPE="3^Remote "_$S($P($G(^XTMP("ORRDI","ART",DFN,ALL,"MECHANISM",0)),"^",2)="ALLERGY":"Allergy",1:"Adverse Reaction")
. . S ORIGDTTM=$$FMTE^XLFDT($$HL7TFM^XLFDT($G(^XTMP("ORRDI","ART",DFN,ALL,"ORIGINATION DATE/TIME",0))))
. . S VERIFY=$S($P($G(^XTMP("ORRDI","ART",DFN,ALL,"VERIFIED",0)),"^")="YES":"Verified",1:"Non-Verified")
. . S DRUGFOOD=$$TITLE^XLFSTR($P($G(^XTMP("ORRDI","ART",DFN,ALL,"TYPE",0)),"^",2))
. . S OBSHIST=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"OBS/HISTORICAL",0)),"^",2)
. . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ")=AGENT_"^"_ORIGDTTM_"^"_OBSHIST
. . S (SYMP,SYMPS)="" F S SYMP=$O(^XTMP("ORRDI","ART",DFN,ALL,"SIGNS/SYMPTOMS",SYMP)) Q:SYMP="" D
. . . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","S",$P($G(^XTMP("ORRDI","ART",DFN,ALL,"SIGNS/SYMPTOMS",SYMP)),"^",2)_" ")=""
. . S SEVERITY=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"SEVERITY",0)),"^",2)
. . S:SEVERITY'="" ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O")=SEVERITY
;
; Bulding Screen with VistA Allergies (Right side)
S ALLLN=LINE-1 K VISTAALL
I VANOASS!VANKA D
. S ALLLN=ALLLN+1,VISTAALL(ALLLN)="|Allergy:"
. I VANOASS=1 D ; No Allergy Assessment
. . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| NO ALLERGY ASSESSMENT"
. . I ERXNKA'="Y",'$O(EALLDATA(0)) S HIGHLN(ALLLN,42)=31
. . E S REVLN(ALLLN,42)=31
. E D
. . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| NO KNOWN ALLERGIES"
. . I ERXNKA="Y" S HIGHLN(ALLLN,42)=18
. . E S REVLN(ALLLN,42)=18
E D
. S (TYPE,VERIFY,DRUGFOOD,AGENT,SYMP)="",UPPERLN=1 K SYMPS
. F S TYPE=$O(ALLLIST(TYPE)) Q:TYPE="" D
. . I '$G(UPPERLN) S ALLLN=ALLLN+1,VISTAALL(ALLLN)="|________________________________________"
. . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="|"_$P(TYPE,"^",2)_":",UPPERLN=0
. . F S VERIFY=$O(ALLLIST(TYPE,VERIFY)) Q:VERIFY="" D
. . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| "_VERIFY_":"
. . . F S DRUGFOOD=$O(ALLLIST(TYPE,VERIFY,DRUGFOOD)) Q:DRUGFOOD="" D
. . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| "_DRUGFOOD_":",UNDERLN(ALLLN,43)=$L(DRUGFOOD)+1
. . . . F S AGENT=$O(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT)) Q:AGENT="" D
. . . . . S Z=ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT)
. . . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| "_$P(Z,"^",1) ;,HIGUNDLN(ALLLN,44)=$L($P(Z,"^",1))
. . . . . I $D(ERXALLS($P(Z,"^",1))) S HIGUNDLN(ALLLN,44)=$L($P(Z,"^",1))
. . . . . E S REVLN(ALLLN,44)=$L($P(Z,"^",1))
. . . . . I $P(Z,"^",2)'="" S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Effective Date: "_$P(Z,"^",2),HIGHLN(ALLLN,60)=$L($P(Z,"^",2))
. . . . . I $P(Z,"^",3)'="" S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Reaction: "_$P(Z,"^",3),HIGHLN(ALLLN,55)=$L($P(Z,"^",3))
. . . . . I $G(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O"))'="" D
. . . . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Severity: "_$G(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O"))
. . . . . . S HIGHLN(ALLLN,55)=$L($G(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O")))
. . . . . I $D(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"S")) D
. . . . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Symptoms:"
. . . . . . S SYMP="" F S SYMP=$O(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"S",SYMP)) Q:SYMP="" D
. . . . . . . D ADDFRTXT(SYMP,0,35,.VISTAALL,.ALLLN,"| ","46^36")
;
; Setting List Content
F ALLLN=5:1 Q:('$D(ERXALL(ALLLN))&'$D(VISTAALL(ALLLN))) D
. S XE=$G(ERXALL(ALLLN))
. S XV=$S($D(VISTAALL(ALLLN)):VISTAALL(ALLLN),1:"|")
. D ADDLINE^PSOERUT0("LM","PSOERALL",XE,XV)
Q
;
ADDFRTXT(TEXT,RS2C,SIZE,ARRAY,ARRLN,PFIX,HIGH) ; Wraps FreeText and adds to existing array
;Input: TEXT - Free Text to be added (long string)
; RS2C - Replace Space with Comma? (1: Yes | 0: No)
; SIZE - Size for Wrapping
; ARRAY - Array where wrapped text should be added (Passed by Ref.)
; ARRLN - Line in the array to add (Passed by Ref.)
; (o)PFIX - Preffix to be included in the beginning of the line
; (o)HIGH - Indicates position to be highlight (P1) and Length (P2) (e.g.,"10^30")
N X,I,TXT,DIWL,DIWR,DIWF,Z
S X=TEXT
K ^UTILITY($J,"W") S DIWL=1,DIWR=SIZE,DIWF="|" D ^DIWP
F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) D
. S TXT=^UTILITY($J,"W",1,I,0) I TXT="" Q
. I RS2C S TXT=$$S2C(TXT)
. S ARRLN=ARRLN+1,ARRAY(ARRLN)=$G(PFIX)_TXT I +$G(HIGH) S HIGHLN(ARRLN,+HIGH)=+$P(HIGH,"^",2)
Q
;
C2S(STR) ; Replaces commas with spaces (for auto-wrap to work) - Arbitrarily using '@' (not likely to be on the string)
N C2S
S C2S=$TR(STR," ","@")
S C2S=$TR(C2S,","," ")
Q C2S
;
S2C(STR) ; Replaces spaces with commas (for auto-wrap to work)
N S2C
S S2C=$TR(STR," ",",")
S S2C=$TR(S2C,"@"," ")
I $E(S2C,$L(S2C))="," S $E(S2C,$L(S2C))=""
Q S2C
;
SORT(STR) ; Sorts a comma (,) separated list alphabetically
N I,SARR,SSTR,WORD
F I=1:1:$L(STR,",") I $TR($P(STR,",",I)," ")'="" S SARR($P(STR,",",I))=""
S (SSTR,WORD)="" F S WORD=$O(SARR(WORD)) Q:WORD="" S SSTR=SSTR_","_WORD
S $E(SSTR)=""
Q SSTR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERALL 12842 printed Apr 09, 2024@21:35:40 Page 2
PSOERALL ;ALB/MR - eRx Patient Allergies ; 8/3/2016 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
+2 ;
EN ; -- main entry point for PSO ERX HOLDING QUEUE
+1 NEW LASTLINE,MBMSITE
+2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+3 ; Call from a Pending Order
+4 IF '$GET(PSOIEN)
IF $GET(ORD)
IF $DATA(^PS(52.41,ORD,0))
NEW PSOIEN
SET PSOIEN=+$$ERXIEN^PSOERXUT(ORD_"P")
+5 IF '$GET(PSOIEN)
Begin DoDot:1
+6 SET VALMSG="This is not an eRx prescription"
SET VALMBCK="R"
WRITE $CHAR(7)
End DoDot:1
QUIT
+7 SET ERXIEN=PSOIEN
+8 DO EN^VALM("PSO ERX PATIENT ALLERGIES")
+9 QUIT
+10 ;
LMHDR ; ListMan Header Code
+1 DO SHOW^VALM
DO HDR^PSOERALL
+2 SET XQORM("??")="D HELP^VALM2,HDR^PSOERALL"
+3 QUIT
+4 ;
HDR ; -- header code
+1 NEW AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
+2 SET AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.6,"I")
SET VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+3 SET VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.13,"E")
SET VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.14,"I")
+4 SET VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM
+5 ;Only Displays Eligibility info if VistA Patient is selected
+6 IF $GET(VPATIEN)
Begin DoDot:1
+7 DO INSTR^VALM1($SELECT($GET(MBMSITE):"ChampVA Rx Benefit: ",1:"Eligibility: ")_IOINHI_$$ELIG^PSOERXP1(VPATIEN)_IOINORM,$SELECT($GET(MBMSITE):41,1:30),2)
End DoDot:1
+8 SET MATCH=$SELECT(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPATIEN:"MANUALLY-MATCHED",1:"")
+9 IF VALUSER'=""
IF MATCH'=""
SET MATCH=MATCH_" | VALIDATED by "_$EXTRACT(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
+10 IF MATCH=""
SET MATCH="NOT MATCHED"
+11 SET $EXTRACT(MATCH,81)=""
DO INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)
+12 SET HDR=""
SET $EXTRACT(HDR,15)="ERX PATIENT"
SET $EXTRACT(HDR,40)="|"
SET $EXTRACT(HDR,54)="VISTA PATIENT"
+13 SET $EXTRACT(HDR,81)=""
DO INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)
+14 QUIT
+15 ;
INIT ;
+1 NEW ERXPAT,PSODFN,DFN,XE,XV,DATA,ERXDM,ERR,ERXNAME,ERXDOB,ERXSSN,VADM,VAPA,VANAME,VADOB,VASSN
+2 NEW HIGHLN,REVLN,UNDERLN,BLINKLN,HIGUNDLN
+3 ;
+4 SET NMSPC="PSOERALL"
+5 ; Required variable: PSOIEN - Pointer to ERX HOLDING QUEUE (#52.49)
+6 IF '$GET(PSOIEN)
QUIT
+7 SET ERXPAT=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
+8 SET (DFN,PSODFN)=+$$VISTAPAT^PSOERUT6(PSOIEN)
+9 ;
+10 KILL ^TMP("PSOERALL",$JOB)
+11 ;eRx Patient Data
+12 DO GETS^DIQ(52.46,ERXPAT_",",".01;.08;1.4","EI","DATA","ERR")
+13 MERGE ERXDM=DATA(52.46,ERXPAT_",")
+14 SET ERXNAME=$EXTRACT(ERXDM(.01,"E"),1,33)
SET ERXDOB=ERXDM(.08,"E")
SET ERXSSN=ERXDM(1.4,"E")
+15 ;VistA Patient Data
+16 SET (VANAME,VADOB,VASSN)=""
+17 IF DFN
Begin DoDot:1
+18 DO DEM^VADPT
DO ADD^VADPT
+19 SET VANAME=$EXTRACT($PIECE(VADM(1),"^"),1,33)
SET VADOB=$PIECE(VADM(3),"^",2)
SET VASSN=$PIECE(VADM(2),"^",2)
End DoDot:1
+20 ;
+21 ; - Resetting list to NORMAL video attributes
+22 DO RESET^PSOERUT0()
+23 ;
+24 SET LINE=1
+25 SET XE="Name: "_$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXNAME,1,33),$GET(VANAME),7)
+26 SET XV="|Name: "_$$COMPARE^PSOERUT0("LM",$GET(VANAME),ERXNAME,47)
+27 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+28 IF $LENGTH(ERXNAME)>33
Begin DoDot:1
+29 SET XE=$$COMPARE^PSOERUT0("LM",$EXTRACT(ERXNAME,34,99),"",7)
+30 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,"|")
End DoDot:1
+31 SET XE="DOB : "_$$COMPARE^PSOERUT0("LM",ERXDOB,$GET(VADOB),7)
+32 SET XV="|DOB : "_$$COMPARE^PSOERUT0("LM",$GET(VADOB),ERXDOB,47)
+33 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+34 SET XE="SSN : "_$$COMPARE^PSOERUT0("LM",ERXSSN,VASSN,7)
+35 SET XV="|SSN : "_$$COMPARE^PSOERUT0("LM",VASSN,ERXSSN,47)
+36 DO ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
+37 ;
+38 DO BLANKLN^PSOERUT0("LM")
+39 DO ALLERGY(PSOIEN,DFN)
+40 DO BLANKLN^PSOERUT0("LM")
+41 ;
+42 SET VALMCNT=LINE-1
+43 ; - Saving NORMAL video attributes to be reset later
+44 IF LINE>$GET(LASTLINE)
Begin DoDot:1
+45 FOR I=($GET(LASTLINE)+1):1:LINE
DO SAVE^VALM10(I)
+46 SET LASTLINE=LINE
End DoDot:1
+47 DO VIDEO^PSOERUT0()
+48 QUIT
+49 ;
HELP ; -- help code
+1 ;S X="?" D DISP^XQORM1 W !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO FULL^VALM1
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
VPA ; Vista Patient Allergies
+1 NEW DFN,PSODFN
+2 IF '$GET(PSOIEN)
QUIT
+3 SET (DFN,PSODFN)=+$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+4 IF '$GET(DFN)
SET VALMSG="No VistA Patient Selected (Not Matched)."
SET VALMBCK="R"
WRITE $CHAR(7)
QUIT
+5 DO ^PSOORUT2
DO EN^PSOLMDA
+6 DO INIT
SET VALMBCK="R"
+7 QUIT
+8 ;
ALLERGY(ERXIEN,DFN) ; VistA Patient Allergy and Adverse Reaction information
+1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; DFN - Pointer to PATIENT File(#2)
+3 ;
+4 NEW IEN,XE,XV,LDAT,GMRA,GMRAL,PSONOAL,LN,TYPE,VANOASS,VANKA,EALLDATA,ALLLN,SEQ,SEV,DRUGFOOD,SYMP,SYMPS
+5 NEW ALL,Z,ZH,VERIFY,TYPE,AGENT,FILE,ERXALL,ALLLIST,ORIGDTTM,SEVERITY,VERIFY,OBSHIST,ALLINFO,LN,SEVER
+6 NEW SEVERS,UPPERLN,ERXALLS,VAALLS,ERXNKA
+7 SET (VANOASS,VANKA)=0
+8 ;
+9 ; Loading VistA Allergies and Building array VAALLS for comparison
+10 IF $GET(DFN)
Begin DoDot:1
+11 ; Local Allergies
+12 SET GMRA="0^0^111^1^0"
DO ^GMRADPT
+13 ; No Allergy Assessment
IF GMRAL=""
SET VANOASS=1
+14 ; No Known Allergies
IF GMRAL=0
SET VANKA=1
+15 IF GMRAL
Begin DoDot:2
+16 SET ALL=0
FOR
SET ALL=$ORDER(GMRAL(ALL))
if 'ALL
QUIT
IF $PIECE($GET(GMRAL(ALL)),"^",2)'=""
SET VAALLS($PIECE(GMRAL(ALL),"^",2))=""
End DoDot:2
+17 ; Remote Allergies
+18 IF $TEXT(HAVEHDR^ORRDI1)'=""
IF $$HAVEHDR^ORRDI1
IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
Begin DoDot:2
+19 DO GET^ORRDI1(DFN,"ART")
Begin DoDot:3
End DoDot:3
+20 IF $PIECE($GET(^XTMP("ORRDI","ART",DFN,0)),"^",3)=0
QUIT
+21 SET ALL=0
FOR
SET ALL=$ORDER(^XTMP("ORRDI","ART",DFN,ALL))
if 'ALL
QUIT
Begin DoDot:3
+22 SET AGENT=$PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"REACTANT",0)),"^",1)
IF AGENT=""
QUIT
+23 SET VAALLS(AGENT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 ; Loading VistA Allergies and Building array ERXALLS for comparison
+26 SET ALLLN=LINE-1
+27 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)="Allergy:"
+28 SET ERXNKA=$$GET1^DIQ(52.49,ERXIEN,302,"I")
+29 IF ERXNKA="Y"
Begin DoDot:1
+30 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)=" NO KNOWN ALLERGIES"
+31 IF VANKA
SET HIGHLN(ALLLN,2)=18
+32 IF '$TEST
SET REVLN(ALLLN,2)=18
End DoDot:1
+33 DO ALRGDATA^PSOERXU9(.EALLDATA,ERXIEN,1)
+34 IF ERXNKA'="Y"
IF '$ORDER(EALLDATA(0))
Begin DoDot:1
+35 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)=" NO ALLERGY INFORMATION RECEIVED"
+36 IF VANOASS
SET HIGHLN(ALLLN,2)=31
+37 IF '$TEST
SET REVLN(ALLLN,2)=31
End DoDot:1
+38 SET SEQ=0
FOR
SET SEQ=$ORDER(EALLDATA(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+39 IF $PIECE($GET(EALLDATA(SEQ)),"^",7)'=""
SET ERXALLS($PIECE(EALLDATA(SEQ),"^",7))=""
End DoDot:1
+40 ;
+41 ; Bulding Screen with eRx Allergies (Left Side)
+42 SET SEQ=0
+43 FOR
SET SEQ=$ORDER(EALLDATA(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+44 SET Z=$GET(EALLDATA(SEQ))
SET AGENT=$PIECE(Z,"^",7)
+45 FOR
if $GET(AGENT)=""
QUIT
Begin DoDot:2
+46 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)=" "_$EXTRACT(AGENT,1,38)
+47 IF $DATA(VAALLS($PIECE(Z,"^",7)))
SET HIGUNDLN(ALLLN,2)=$SELECT($LENGTH(AGENT)>38:38,1:$LENGTH(AGENT))
+48 IF '$TEST
SET REVLN(ALLLN,2)=$SELECT($LENGTH(AGENT)>38:38,1:$LENGTH(AGENT))
+49 SET AGENT=$EXTRACT(AGENT,39,999)
End DoDot:2
+50 IF $PIECE(Z,"^",3)
Begin DoDot:2
+51 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)=" Effective Date: "_$$FMTE^XLFDT($PIECE(Z,"^",3))
+52 SET HIGHLN(ALLLN,20)=12
End DoDot:2
+53 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)=" Severity: "
+54 DO ADDFRTXT($PIECE(Z,"^",10),0,35,.ERXALL,.ALLLN," ","5^35")
+55 IF $PIECE(Z,"^",8)'=""
Begin DoDot:2
+56 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)=" Reaction: "
+57 DO ADDFRTXT($PIECE(Z,"^",8),0,35,.ERXALL,.ALLLN," ","5^35")
End DoDot:2
+58 SET ALLLN=ALLLN+1
SET ERXALL(ALLLN)=" Symptoms: "
+59 DO ADDFRTXT($PIECE(Z,"^",12),0,35,.ERXALL,.ALLLN," ","5^35")
End DoDot:1
+60 ;
+61 ; Gathering Local VistA Allergies Details
+62 KILL ALLLIST,REF
+63 IF $GET(DFN)
Begin DoDot:1
+64 ; Allergies Found
IF GMRAL
Begin DoDot:2
+65 SET ALL=0
FOR
SET ALL=$ORDER(GMRAL(ALL))
if 'ALL
QUIT
Begin DoDot:3
+66 SET Z=GMRAL(ALL)
SET ZH=$GET(GMRAL(ALL,"H"))
+67 KILL ALLINFO
DO EN1^GMRAOR2(ALL,"ALLINFO")
+68 SET AGENT=$PIECE(ALLINFO,"^",1)
SET VERIFY=$$TITLE^XLFSTR($PIECE(ALLINFO,"^",4))
SET OBSHIST=$PIECE(ALLINFO,"^",5)
+69 SET TYPE=$SELECT($PIECE(ALLINFO,"^",6)="ALLERGY":"1^Allergy",1:"2^Adverse Reaction")
+70 SET DRUGFOOD=$$TITLE^XLFSTR($PIECE(ALLINFO,"^",7))
SET DRUGFOOD=$TRANSLATE(DRUGFOOD," ")
SET DRUGFOOD=$TRANSLATE(DRUGFOOD,",","/")
+71 SET ORIGDTTM=$PIECE(ALLINFO,"^",10)
+72 SET ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ")=AGENT_"^"_ORIGDTTM_"^"_OBSHIST
+73 SET SEVERITY=""
+74 IF $DATA(ALLINFO("H"))
SET SEVERITY=$PIECE($GET(ALLINFO("H")),"^",2)
+75 IF $DATA(ALLINFO("O"))
SET SEV=$ORDER(ALLINFO("O",0))
IF SEV
SET SEVERITY=$PIECE($GET(ALLINFO("O",SEV)),"^",2)
+76 if (SEVERITY'="")
SET ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","O")=SEVERITY
+77 SET (SYMP,SYMPS)=""
FOR
SET SYMP=$ORDER(ALLINFO("S",SYMP))
if SYMP=""
QUIT
Begin DoDot:4
+78 SET ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","S",$GET(ALLINFO("S",SYMP))_" ")=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+79 ;
+80 ; Gathering Remote VistA Allergies
+81 IF $GET(DFN)
Begin DoDot:1
+82 SET ALL=0
FOR
SET ALL=$ORDER(^XTMP("ORRDI","ART",DFN,ALL))
if 'ALL
QUIT
Begin DoDot:2
+83 SET Z=$GET(^XTMP("ORRDI","ART",DFN,ALL,"GMRALLERGY",0))
+84 SET FILE=$PIECE($PIECE(Z,"^",3),"99VA",2)
+85 IF FILE'=50.6
IF FILE'=120.82
IF FILE'=50.605
IF FILE'=50.416
QUIT
+86 SET AGENT=$PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"REACTANT",0)),"^",1)
+87 SET TYPE="3^Remote "_$SELECT($PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"MECHANISM",0)),"^",2)="ALLERGY":"Allergy",1:"Adverse Reaction")
+88 SET ORIGDTTM=$$FMTE^XLFDT($$HL7TFM^XLFDT($GET(^XTMP("ORRDI","ART",DFN,ALL,"ORIGINATION DATE/TIME",0))))
+89 SET VERIFY=$SELECT($PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"VERIFIED",0)),"^")="YES":"Verified",1:"Non-Verified")
+90 SET DRUGFOOD=$$TITLE^XLFSTR($PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"TYPE",0)),"^",2))
+91 SET OBSHIST=$PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"OBS/HISTORICAL",0)),"^",2)
+92 SET ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ")=AGENT_"^"_ORIGDTTM_"^"_OBSHIST
+93 SET (SYMP,SYMPS)=""
FOR
SET SYMP=$ORDER(^XTMP("ORRDI","ART",DFN,ALL,"SIGNS/SYMPTOMS",SYMP))
if SYMP=""
QUIT
Begin DoDot:3
+94 SET ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","S",$PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"SIGNS/SYMPTOMS",SYMP)),"^",2)_" ")=""
End DoDot:3
+95 SET SEVERITY=$PIECE($GET(^XTMP("ORRDI","ART",DFN,ALL,"SEVERITY",0)),"^",2)
+96 if SEVERITY'=""
SET ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O")=SEVERITY
End DoDot:2
End DoDot:1
+97 ;
+98 ; Bulding Screen with VistA Allergies (Right side)
+99 SET ALLLN=LINE-1
KILL VISTAALL
+100 IF VANOASS!VANKA
Begin DoDot:1
+101 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="|Allergy:"
+102 ; No Allergy Assessment
IF VANOASS=1
Begin DoDot:2
+103 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| NO ALLERGY ASSESSMENT"
+104 IF ERXNKA'="Y"
IF '$ORDER(EALLDATA(0))
SET HIGHLN(ALLLN,42)=31
+105 IF '$TEST
SET REVLN(ALLLN,42)=31
End DoDot:2
+106 IF '$TEST
Begin DoDot:2
+107 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| NO KNOWN ALLERGIES"
+108 IF ERXNKA="Y"
SET HIGHLN(ALLLN,42)=18
+109 IF '$TEST
SET REVLN(ALLLN,42)=18
End DoDot:2
End DoDot:1
+110 IF '$TEST
Begin DoDot:1
+111 SET (TYPE,VERIFY,DRUGFOOD,AGENT,SYMP)=""
SET UPPERLN=1
KILL SYMPS
+112 FOR
SET TYPE=$ORDER(ALLLIST(TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+113 IF '$GET(UPPERLN)
SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="|________________________________________"
+114 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="|"_$PIECE(TYPE,"^",2)_":"
SET UPPERLN=0
+115 FOR
SET VERIFY=$ORDER(ALLLIST(TYPE,VERIFY))
if VERIFY=""
QUIT
Begin DoDot:3
+116 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| "_VERIFY_":"
+117 FOR
SET DRUGFOOD=$ORDER(ALLLIST(TYPE,VERIFY,DRUGFOOD))
if DRUGFOOD=""
QUIT
Begin DoDot:4
+118 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| "_DRUGFOOD_":"
SET UNDERLN(ALLLN,43)=$LENGTH(DRUGFOOD)+1
+119 FOR
SET AGENT=$ORDER(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT))
if AGENT=""
QUIT
Begin DoDot:5
+120 SET Z=ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT)
+121 ;,HIGUNDLN(ALLLN,44)=$L($P(Z,"^",1))
SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| "_$PIECE(Z,"^",1)
+122 IF $DATA(ERXALLS($PIECE(Z,"^",1)))
SET HIGUNDLN(ALLLN,44)=$LENGTH($PIECE(Z,"^",1))
+123 IF '$TEST
SET REVLN(ALLLN,44)=$LENGTH($PIECE(Z,"^",1))
+124 IF $PIECE(Z,"^",2)'=""
SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| Effective Date: "_$PIECE(Z,"^",2)
SET HIGHLN(ALLLN,60)=$LENGTH($PIECE(Z,"^",2))
+125 IF $PIECE(Z,"^",3)'=""
SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| Reaction: "_$PIECE(Z,"^",3)
SET HIGHLN(ALLLN,55)=$LENGTH($PIECE(Z,"^",3))
+126 IF $GET(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O"))'=""
Begin DoDot:6
+127 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| Severity: "_$GET(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O"))
+128 SET HIGHLN(ALLLN,55)=$LENGTH($GET(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O")))
End DoDot:6
+129 IF $DATA(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"S"))
Begin DoDot:6
+130 SET ALLLN=ALLLN+1
SET VISTAALL(ALLLN)="| Symptoms:"
+131 SET SYMP=""
FOR
SET SYMP=$ORDER(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"S",SYMP))
if SYMP=""
QUIT
Begin DoDot:7
+132 DO ADDFRTXT(SYMP,0,35,.VISTAALL,.ALLLN,"| ","46^36")
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+133 ;
+134 ; Setting List Content
+135 FOR ALLLN=5:1
if ('$DATA(ERXALL(ALLLN))&'$DATA(VISTAALL(ALLLN)))
QUIT
Begin DoDot:1
+136 SET XE=$GET(ERXALL(ALLLN))
+137 SET XV=$SELECT($DATA(VISTAALL(ALLLN)):VISTAALL(ALLLN),1:"|")
+138 DO ADDLINE^PSOERUT0("LM","PSOERALL",XE,XV)
End DoDot:1
+139 QUIT
+140 ;
ADDFRTXT(TEXT,RS2C,SIZE,ARRAY,ARRLN,PFIX,HIGH) ; Wraps FreeText and adds to existing array
+1 ;Input: TEXT - Free Text to be added (long string)
+2 ; RS2C - Replace Space with Comma? (1: Yes | 0: No)
+3 ; SIZE - Size for Wrapping
+4 ; ARRAY - Array where wrapped text should be added (Passed by Ref.)
+5 ; ARRLN - Line in the array to add (Passed by Ref.)
+6 ; (o)PFIX - Preffix to be included in the beginning of the line
+7 ; (o)HIGH - Indicates position to be highlight (P1) and Length (P2) (e.g.,"10^30")
+8 NEW X,I,TXT,DIWL,DIWR,DIWF,Z
+9 SET X=TEXT
+10 KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=SIZE
SET DIWF="|"
DO ^DIWP
+11 FOR I=1:1
if '$DATA(^UTILITY($JOB,"W",1,I))
QUIT
Begin DoDot:1
+12 SET TXT=^UTILITY($JOB,"W",1,I,0)
IF TXT=""
QUIT
+13 IF RS2C
SET TXT=$$S2C(TXT)
+14 SET ARRLN=ARRLN+1
SET ARRAY(ARRLN)=$GET(PFIX)_TXT
IF +$GET(HIGH)
SET HIGHLN(ARRLN,+HIGH)=+$PIECE(HIGH,"^",2)
End DoDot:1
+15 QUIT
+16 ;
C2S(STR) ; Replaces commas with spaces (for auto-wrap to work) - Arbitrarily using '@' (not likely to be on the string)
+1 NEW C2S
+2 SET C2S=$TRANSLATE(STR," ","@")
+3 SET C2S=$TRANSLATE(C2S,","," ")
+4 QUIT C2S
+5 ;
S2C(STR) ; Replaces spaces with commas (for auto-wrap to work)
+1 NEW S2C
+2 SET S2C=$TRANSLATE(STR," ",",")
+3 SET S2C=$TRANSLATE(S2C,"@"," ")
+4 IF $EXTRACT(S2C,$LENGTH(S2C))=","
SET $EXTRACT(S2C,$LENGTH(S2C))=""
+5 QUIT S2C
+6 ;
SORT(STR) ; Sorts a comma (,) separated list alphabetically
+1 NEW I,SARR,SSTR,WORD
+2 FOR I=1:1:$LENGTH(STR,",")
IF $TRANSLATE($PIECE(STR,",",I)," ")'=""
SET SARR($PIECE(STR,",",I))=""
+3 SET (SSTR,WORD)=""
FOR
SET WORD=$ORDER(SARR(WORD))
if WORD=""
QUIT
SET SSTR=SSTR_","_WORD
+4 SET $EXTRACT(SSTR)=""
+5 QUIT SSTR
