- 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 Feb 18, 2025@23:54:05 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