Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERALL

PSOERALL.m

Go to the documentation of this file.
  1. PSOERALL ;ALB/MR - eRx Patient Allergies ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
  1. ;
  1. EN ; -- main entry point for PSO ERX HOLDING QUEUE
  1. N LASTLINE,MBMSITE
  1. S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
  1. ; Call from a Pending Order
  1. I '$G(PSOIEN),$G(ORD),$D(^PS(52.41,ORD,0)) N PSOIEN S PSOIEN=+$$ERXIEN^PSOERXUT(ORD_"P")
  1. I '$G(PSOIEN) D Q
  1. . S VALMSG="This is not an eRx prescription",VALMBCK="R" W $C(7)
  1. S ERXIEN=PSOIEN
  1. D EN^VALM("PSO ERX PATIENT ALLERGIES")
  1. Q
  1. ;
  1. LMHDR ; ListMan Header Code
  1. D SHOW^VALM,HDR^PSOERALL
  1. S XQORM("??")="D HELP^VALM2,HDR^PSOERALL"
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N AMATCH,VPATIEN,VALUSER,VALDTTM,MATCH,HDR
  1. S AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.6,"I"),VPATIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
  1. S VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.13,"E"),VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.14,"I")
  1. S VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM
  1. ;Only Displays Eligibility info if VistA Patient is selected
  1. I $G(VPATIEN) D
  1. . D INSTR^VALM1($S($G(MBMSITE):"ChampVA Rx Benefit: ",1:"Eligibility: ")_IOINHI_$$ELIG^PSOERXP1(VPATIEN)_IOINORM,$S($G(MBMSITE):41,1:30),2)
  1. S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPATIEN:"MANUALLY-MATCHED",1:"")
  1. I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
  1. I MATCH="" S MATCH="NOT MATCHED"
  1. S $E(MATCH,81)="" D INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)
  1. S HDR="",$E(HDR,15)="ERX PATIENT",$E(HDR,40)="|",$E(HDR,54)="VISTA PATIENT"
  1. S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)
  1. Q
  1. ;
  1. INIT ;
  1. N ERXPAT,PSODFN,DFN,XE,XV,DATA,ERXDM,ERR,ERXNAME,ERXDOB,ERXSSN,VADM,VAPA,VANAME,VADOB,VASSN
  1. N HIGHLN,REVLN,UNDERLN,BLINKLN,HIGUNDLN
  1. ;
  1. S NMSPC="PSOERALL"
  1. ; Required variable: PSOIEN - Pointer to ERX HOLDING QUEUE (#52.49)
  1. I '$G(PSOIEN) Q
  1. S ERXPAT=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
  1. S (DFN,PSODFN)=+$$VISTAPAT^PSOERUT6(PSOIEN)
  1. ;
  1. K ^TMP("PSOERALL",$J)
  1. ;eRx Patient Data
  1. D GETS^DIQ(52.46,ERXPAT_",",".01;.08;1.4","EI","DATA","ERR")
  1. M ERXDM=DATA(52.46,ERXPAT_",")
  1. S ERXNAME=$E(ERXDM(.01,"E"),1,33),ERXDOB=ERXDM(.08,"E"),ERXSSN=ERXDM(1.4,"E")
  1. ;VistA Patient Data
  1. S (VANAME,VADOB,VASSN)=""
  1. I DFN D
  1. . D DEM^VADPT,ADD^VADPT
  1. . S VANAME=$E($P(VADM(1),"^"),1,33),VADOB=$P(VADM(3),"^",2),VASSN=$P(VADM(2),"^",2)
  1. ;
  1. ; - Resetting list to NORMAL video attributes
  1. D RESET^PSOERUT0()
  1. ;
  1. S LINE=1
  1. S XE="Name: "_$$COMPARE^PSOERUT0("LM",$E(ERXNAME,1,33),$G(VANAME),7)
  1. S XV="|Name: "_$$COMPARE^PSOERUT0("LM",$G(VANAME),ERXNAME,47)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. I $L(ERXNAME)>33 D
  1. . S XE=$$COMPARE^PSOERUT0("LM",$E(ERXNAME,34,99),"",7)
  1. . D ADDLINE^PSOERUT0("LM",NMSPC,XE,"|")
  1. S XE="DOB : "_$$COMPARE^PSOERUT0("LM",ERXDOB,$G(VADOB),7)
  1. S XV="|DOB : "_$$COMPARE^PSOERUT0("LM",$G(VADOB),ERXDOB,47)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. S XE="SSN : "_$$COMPARE^PSOERUT0("LM",ERXSSN,VASSN,7)
  1. S XV="|SSN : "_$$COMPARE^PSOERUT0("LM",VASSN,ERXSSN,47)
  1. D ADDLINE^PSOERUT0("LM",NMSPC,XE,XV)
  1. ;
  1. D BLANKLN^PSOERUT0("LM")
  1. D ALLERGY(PSOIEN,DFN)
  1. D BLANKLN^PSOERUT0("LM")
  1. ;
  1. S VALMCNT=LINE-1
  1. ; - Saving NORMAL video attributes to be reset later
  1. I LINE>$G(LASTLINE) D
  1. . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
  1. . S LASTLINE=LINE
  1. D VIDEO^PSOERUT0()
  1. Q
  1. ;
  1. HELP ; -- help code
  1. ;S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. D FULL^VALM1
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. VPA ; Vista Patient Allergies
  1. N DFN,PSODFN
  1. I '$G(PSOIEN) Q
  1. S (DFN,PSODFN)=+$$GET1^DIQ(52.49,PSOIEN,.05,"I")
  1. I '$G(DFN) S VALMSG="No VistA Patient Selected (Not Matched).",VALMBCK="R" W $C(7) Q
  1. D ^PSOORUT2,EN^PSOLMDA
  1. D INIT S VALMBCK="R"
  1. Q
  1. ;
  1. ALLERGY(ERXIEN,DFN) ; VistA Patient Allergy and Adverse Reaction information
  1. ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; DFN - Pointer to PATIENT File(#2)
  1. ;
  1. N IEN,XE,XV,LDAT,GMRA,GMRAL,PSONOAL,LN,TYPE,VANOASS,VANKA,EALLDATA,ALLLN,SEQ,SEV,DRUGFOOD,SYMP,SYMPS
  1. N ALL,Z,ZH,VERIFY,TYPE,AGENT,FILE,ERXALL,ALLLIST,ORIGDTTM,SEVERITY,VERIFY,OBSHIST,ALLINFO,LN,SEVER
  1. N SEVERS,UPPERLN,ERXALLS,VAALLS,ERXNKA
  1. S (VANOASS,VANKA)=0
  1. ;
  1. ; Loading VistA Allergies and Building array VAALLS for comparison
  1. I $G(DFN) D
  1. . ; Local Allergies
  1. . S GMRA="0^0^111^1^0" D ^GMRADPT
  1. . I GMRAL="" S VANOASS=1 ; No Allergy Assessment
  1. . I GMRAL=0 S VANKA=1 ; No Known Allergies
  1. . I GMRAL D
  1. . . S ALL=0 F S ALL=$O(GMRAL(ALL)) Q:'ALL I $P($G(GMRAL(ALL)),"^",2)'="" S VAALLS($P(GMRAL(ALL),"^",2))=""
  1. . ; Remote Allergies
  1. . I $T(HAVEHDR^ORRDI1)'="",$$HAVEHDR^ORRDI1,$D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D
  1. . . D GET^ORRDI1(DFN,"ART") D
  1. . . I $P($G(^XTMP("ORRDI","ART",DFN,0)),"^",3)=0 Q
  1. . . S ALL=0 F S ALL=$O(^XTMP("ORRDI","ART",DFN,ALL)) Q:'ALL D
  1. . . . S AGENT=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"REACTANT",0)),"^",1) I AGENT="" Q
  1. . . . S VAALLS(AGENT)=""
  1. ;
  1. ; Loading VistA Allergies and Building array ERXALLS for comparison
  1. S ALLLN=LINE-1
  1. S ALLLN=ALLLN+1,ERXALL(ALLLN)="Allergy:"
  1. S ERXNKA=$$GET1^DIQ(52.49,ERXIEN,302,"I")
  1. I ERXNKA="Y" D
  1. . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" NO KNOWN ALLERGIES"
  1. . I VANKA S HIGHLN(ALLLN,2)=18
  1. . E S REVLN(ALLLN,2)=18
  1. D ALRGDATA^PSOERXU9(.EALLDATA,ERXIEN,1)
  1. I ERXNKA'="Y",'$O(EALLDATA(0)) D
  1. . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" NO ALLERGY INFORMATION RECEIVED"
  1. . I VANOASS S HIGHLN(ALLLN,2)=31
  1. . E S REVLN(ALLLN,2)=31
  1. S SEQ=0 F S SEQ=$O(EALLDATA(SEQ)) Q:'SEQ D
  1. . I $P($G(EALLDATA(SEQ)),"^",7)'="" S ERXALLS($P(EALLDATA(SEQ),"^",7))=""
  1. ;
  1. ; Bulding Screen with eRx Allergies (Left Side)
  1. S SEQ=0
  1. F S SEQ=$O(EALLDATA(SEQ)) Q:'SEQ D
  1. . S Z=$G(EALLDATA(SEQ)),AGENT=$P(Z,"^",7)
  1. . F Q:$G(AGENT)="" D
  1. . . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" "_$E(AGENT,1,38)
  1. . . I $D(VAALLS($P(Z,"^",7))) S HIGUNDLN(ALLLN,2)=$S($L(AGENT)>38:38,1:$L(AGENT))
  1. . . E S REVLN(ALLLN,2)=$S($L(AGENT)>38:38,1:$L(AGENT))
  1. . . S AGENT=$E(AGENT,39,999)
  1. . I $P(Z,"^",3) D
  1. . . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Effective Date: "_$$FMTE^XLFDT($P(Z,"^",3))
  1. . . S HIGHLN(ALLLN,20)=12
  1. . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Severity: "
  1. . D ADDFRTXT($P(Z,"^",10),0,35,.ERXALL,.ALLLN," ","5^35")
  1. . I $P(Z,"^",8)'="" D
  1. . . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Reaction: "
  1. . . D ADDFRTXT($P(Z,"^",8),0,35,.ERXALL,.ALLLN," ","5^35")
  1. . S ALLLN=ALLLN+1,ERXALL(ALLLN)=" Symptoms: "
  1. . D ADDFRTXT($P(Z,"^",12),0,35,.ERXALL,.ALLLN," ","5^35")
  1. ;
  1. ; Gathering Local VistA Allergies Details
  1. K ALLLIST,REF
  1. I $G(DFN) D
  1. . I GMRAL D ; Allergies Found
  1. . . S ALL=0 F S ALL=$O(GMRAL(ALL)) Q:'ALL D
  1. . . . S Z=GMRAL(ALL),ZH=$G(GMRAL(ALL,"H"))
  1. . . . K ALLINFO D EN1^GMRAOR2(ALL,"ALLINFO")
  1. . . . S AGENT=$P(ALLINFO,"^",1),VERIFY=$$TITLE^XLFSTR($P(ALLINFO,"^",4)),OBSHIST=$P(ALLINFO,"^",5)
  1. . . . S TYPE=$S($P(ALLINFO,"^",6)="ALLERGY":"1^Allergy",1:"2^Adverse Reaction")
  1. . . . S DRUGFOOD=$$TITLE^XLFSTR($P(ALLINFO,"^",7)),DRUGFOOD=$TR(DRUGFOOD," "),DRUGFOOD=$TR(DRUGFOOD,",","/")
  1. . . . S ORIGDTTM=$P(ALLINFO,"^",10)
  1. . . . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ")=AGENT_"^"_ORIGDTTM_"^"_OBSHIST
  1. . . . S SEVERITY=""
  1. . . . I $D(ALLINFO("H")) S SEVERITY=$P($G(ALLINFO("H")),"^",2)
  1. . . . I $D(ALLINFO("O")) S SEV=$O(ALLINFO("O",0)) I SEV S SEVERITY=$P($G(ALLINFO("O",SEV)),"^",2)
  1. . . . S:(SEVERITY'="") ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","O")=SEVERITY
  1. . . . S (SYMP,SYMPS)="" F S SYMP=$O(ALLINFO("S",SYMP)) Q:SYMP="" D
  1. . . . . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","S",$G(ALLINFO("S",SYMP))_" ")=""
  1. ;
  1. ; Gathering Remote VistA Allergies
  1. I $G(DFN) D
  1. . S ALL=0 F S ALL=$O(^XTMP("ORRDI","ART",DFN,ALL)) Q:'ALL D
  1. . . S Z=$G(^XTMP("ORRDI","ART",DFN,ALL,"GMRALLERGY",0))
  1. . . S FILE=$P($P(Z,"^",3),"99VA",2)
  1. . . I FILE'=50.6,FILE'=120.82,FILE'=50.605,FILE'=50.416 Q
  1. . . S AGENT=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"REACTANT",0)),"^",1)
  1. . . S TYPE="3^Remote "_$S($P($G(^XTMP("ORRDI","ART",DFN,ALL,"MECHANISM",0)),"^",2)="ALLERGY":"Allergy",1:"Adverse Reaction")
  1. . . S ORIGDTTM=$$FMTE^XLFDT($$HL7TFM^XLFDT($G(^XTMP("ORRDI","ART",DFN,ALL,"ORIGINATION DATE/TIME",0))))
  1. . . S VERIFY=$S($P($G(^XTMP("ORRDI","ART",DFN,ALL,"VERIFIED",0)),"^")="YES":"Verified",1:"Non-Verified")
  1. . . S DRUGFOOD=$$TITLE^XLFSTR($P($G(^XTMP("ORRDI","ART",DFN,ALL,"TYPE",0)),"^",2))
  1. . . S OBSHIST=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"OBS/HISTORICAL",0)),"^",2)
  1. . . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ")=AGENT_"^"_ORIGDTTM_"^"_OBSHIST
  1. . . S (SYMP,SYMPS)="" F S SYMP=$O(^XTMP("ORRDI","ART",DFN,ALL,"SIGNS/SYMPTOMS",SYMP)) Q:SYMP="" D
  1. . . . S ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT_" ","S",$P($G(^XTMP("ORRDI","ART",DFN,ALL,"SIGNS/SYMPTOMS",SYMP)),"^",2)_" ")=""
  1. . . S SEVERITY=$P($G(^XTMP("ORRDI","ART",DFN,ALL,"SEVERITY",0)),"^",2)
  1. . . S:SEVERITY'="" ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O")=SEVERITY
  1. ;
  1. ; Bulding Screen with VistA Allergies (Right side)
  1. S ALLLN=LINE-1 K VISTAALL
  1. I VANOASS!VANKA D
  1. . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="|Allergy:"
  1. . I VANOASS=1 D ; No Allergy Assessment
  1. . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| NO ALLERGY ASSESSMENT"
  1. . . I ERXNKA'="Y",'$O(EALLDATA(0)) S HIGHLN(ALLLN,42)=31
  1. . . E S REVLN(ALLLN,42)=31
  1. . E D
  1. . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| NO KNOWN ALLERGIES"
  1. . . I ERXNKA="Y" S HIGHLN(ALLLN,42)=18
  1. . . E S REVLN(ALLLN,42)=18
  1. E D
  1. . S (TYPE,VERIFY,DRUGFOOD,AGENT,SYMP)="",UPPERLN=1 K SYMPS
  1. . F S TYPE=$O(ALLLIST(TYPE)) Q:TYPE="" D
  1. . . I '$G(UPPERLN) S ALLLN=ALLLN+1,VISTAALL(ALLLN)="|________________________________________"
  1. . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="|"_$P(TYPE,"^",2)_":",UPPERLN=0
  1. . . F S VERIFY=$O(ALLLIST(TYPE,VERIFY)) Q:VERIFY="" D
  1. . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| "_VERIFY_":"
  1. . . . F S DRUGFOOD=$O(ALLLIST(TYPE,VERIFY,DRUGFOOD)) Q:DRUGFOOD="" D
  1. . . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| "_DRUGFOOD_":",UNDERLN(ALLLN,43)=$L(DRUGFOOD)+1
  1. . . . . F S AGENT=$O(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT)) Q:AGENT="" D
  1. . . . . . S Z=ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT)
  1. . . . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| "_$P(Z,"^",1) ;,HIGUNDLN(ALLLN,44)=$L($P(Z,"^",1))
  1. . . . . . I $D(ERXALLS($P(Z,"^",1))) S HIGUNDLN(ALLLN,44)=$L($P(Z,"^",1))
  1. . . . . . E S REVLN(ALLLN,44)=$L($P(Z,"^",1))
  1. . . . . . I $P(Z,"^",2)'="" S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Effective Date: "_$P(Z,"^",2),HIGHLN(ALLLN,60)=$L($P(Z,"^",2))
  1. . . . . . I $P(Z,"^",3)'="" S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Reaction: "_$P(Z,"^",3),HIGHLN(ALLLN,55)=$L($P(Z,"^",3))
  1. . . . . . I $G(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O"))'="" D
  1. . . . . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Severity: "_$G(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O"))
  1. . . . . . . S HIGHLN(ALLLN,55)=$L($G(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"O")))
  1. . . . . . I $D(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"S")) D
  1. . . . . . . S ALLLN=ALLLN+1,VISTAALL(ALLLN)="| Symptoms:"
  1. . . . . . . S SYMP="" F S SYMP=$O(ALLLIST(TYPE,VERIFY,DRUGFOOD,AGENT,"S",SYMP)) Q:SYMP="" D
  1. . . . . . . . D ADDFRTXT(SYMP,0,35,.VISTAALL,.ALLLN,"| ","46^36")
  1. ;
  1. ; Setting List Content
  1. F ALLLN=5:1 Q:('$D(ERXALL(ALLLN))&'$D(VISTAALL(ALLLN))) D
  1. . S XE=$G(ERXALL(ALLLN))
  1. . S XV=$S($D(VISTAALL(ALLLN)):VISTAALL(ALLLN),1:"|")
  1. . D ADDLINE^PSOERUT0("LM","PSOERALL",XE,XV)
  1. Q
  1. ;
  1. 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)
  1. ; RS2C - Replace Space with Comma? (1: Yes | 0: No)
  1. ; SIZE - Size for Wrapping
  1. ; ARRAY - Array where wrapped text should be added (Passed by Ref.)
  1. ; ARRLN - Line in the array to add (Passed by Ref.)
  1. ; (o)PFIX - Preffix to be included in the beginning of the line
  1. ; (o)HIGH - Indicates position to be highlight (P1) and Length (P2) (e.g.,"10^30")
  1. N X,I,TXT,DIWL,DIWR,DIWF,Z
  1. S X=TEXT
  1. K ^UTILITY($J,"W") S DIWL=1,DIWR=SIZE,DIWF="|" D ^DIWP
  1. F I=1:1 Q:'$D(^UTILITY($J,"W",1,I)) D
  1. . S TXT=^UTILITY($J,"W",1,I,0) I TXT="" Q
  1. . I RS2C S TXT=$$S2C(TXT)
  1. . S ARRLN=ARRLN+1,ARRAY(ARRLN)=$G(PFIX)_TXT I +$G(HIGH) S HIGHLN(ARRLN,+HIGH)=+$P(HIGH,"^",2)
  1. Q
  1. ;
  1. C2S(STR) ; Replaces commas with spaces (for auto-wrap to work) - Arbitrarily using '@' (not likely to be on the string)
  1. N C2S
  1. S C2S=$TR(STR," ","@")
  1. S C2S=$TR(C2S,","," ")
  1. Q C2S
  1. ;
  1. S2C(STR) ; Replaces spaces with commas (for auto-wrap to work)
  1. N S2C
  1. S S2C=$TR(STR," ",",")
  1. S S2C=$TR(S2C,"@"," ")
  1. I $E(S2C,$L(S2C))="," S $E(S2C,$L(S2C))=""
  1. Q S2C
  1. ;
  1. SORT(STR) ; Sorts a comma (,) separated list alphabetically
  1. N I,SARR,SSTR,WORD
  1. F I=1:1:$L(STR,",") I $TR($P(STR,",",I)," ")'="" S SARR($P(STR,",",I))=""
  1. S (SSTR,WORD)="" F S WORD=$O(SARR(WORD)) Q:WORD="" S SSTR=SSTR_","_WORD
  1. S $E(SSTR)=""
  1. Q SSTR