PSSPGXUT ;BIR/RTR - PHARMACOGENOMICS UTILITY ROUTINE ;09/20/07
;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
;
DATA(PSSGNPH,PSSRESUL) ;Validate HDR Gene and Phenotype data to send to vendor
;PSSRESUL(N, "GENE") = Gene from HDR ^ Vendor mapped Gene ^ 1 if not map
;PSSRESUL(N, "PHENOTYPE") = Pheno type from HDR ^ Vendor mapped Phenotype ^ 1 if not map
N PSSGNDAT,PSSPHDAT,PSSCTR,PSSINV,PSSELOG,PSSNOFDB
S PSSCTR="" F S PSSCTR=$O(PSSGNPH(PSSCTR)) Q:'PSSCTR D
.S PSSGNDAT=$G(PSSGNPH(PSSCTR,"GENE")),PSSPHDAT=$G(PSSGNPH(PSSCTR,"PHENOTYPE"))
.S:PSSGNDAT="" PSSGNDAT="NULL" S:PSSPHDAT="" PSSPHDAT="NULL"
.S PSSRESUL(PSSCTR,"GENE")=PSSGNDAT_"^"_$$GENE(PSSGNDAT)
.S PSSRESUL(PSSCTR,"PHENOTYPE")=PSSPHDAT_"^"_$$PHEN(PSSPHDAT) I PSSNOFDB S PSSRESUL(PSSCTR,"NOFDB")=""
I '$D(PSSINV) Q
D MESS
Q
;
GENE(PSSGNE) ;Find vendor gene equivalent
;PSSGRSLT=GENE^FLAG(if can't map)
N PSSCR,PSSGIEN,PSSGRSLT,PSSGNEC
S PSSGIEN=0
I $G(PSSGNE)="NULL" S PSSINV("G",PSSCTR)="" Q $G(PSSGNE)_"^1"
S PSSGNEC=$$UP^XLFSTR(PSSGNE)
F PSSCR="C","B","D" Q:PSSGIEN S PSSGIEN=$O(^PS(51.26,PSSCR,PSSGNEC,0))
I 'PSSGIEN S PSSINV("G",PSSCTR)="" Q $G(PSSGNE)_"^1"
S PSSGRSLT=$P($G(^PS(51.26,PSSGIEN,0)),"^",2) I PSSGRSLT="" S PSSINV("G",PSSCTR)="" Q $G(PSSGNE)_"^1"
Q PSSGRSLT_"^"
;
PHEN(PSSPNT) ;Find vendor phenotype equivalent
;PSSPRSLT=PHENO^FLAG(if can't map)
N PSSCRT,PSSPIEN,PSSPRSLT,PSSPNTC
S (PSSPIEN,PSSNOFDB)=0
I $G(PSSPNT)="NULL" S PSSINV("P",PSSCTR)="" Q $G(PSSPNT)_"^1"
S PSSPNTC=$$UP^XLFSTR(PSSPNT)
F PSSCRT="C","B","D" Q:PSSPIEN S PSSPIEN=$O(^PS(51.28,PSSCRT,PSSPNTC,0))
I 'PSSPIEN S PSSINV("P",PSSCTR)="" Q $G(PSSPNT)_"^1"
S PSSPRSLT=$P($G(^PS(51.28,PSSPIEN,0)),"^",2) I PSSPRSLT="" S PSSINV("P",PSSCTR)="",PSSNOFDB=1 Q $G(PSSPNT)_"^1"
Q PSSPRSLT_"^"
;
MESS ;Send message of unresolvable genes/phenotypes to Pharmacy Benefits Management
N PSSPGXST,PSSINLP,PSSICT,PSSXTEXT,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
Q:'$$PGXEMAIL^PSSPGXU2(PSSDFN,PSSICN,.PSSRESUL,.PSSINV)
S PSSPGXST=$$SITE^VASITE,PSSICT=1
S XMDUZ="UNRESOLVABLE PGX DATA"
S XMSUB="UNRESOLVABLE PGX DATA FROM "_$P(PSSPGXST,"^",2)_" "_$P(PSSPGXST,"^",3)
S PSSINLP="" F S PSSINLP=$O(PSSINV("G",PSSINLP)) Q:'PSSINLP D
.D ADDLN
.S PSSXTEXT(PSSICT)="The following Patient Specific Gene that is available for use in the PGx Order Check could not be found in the Gene file in Vista:"
.D ADDLN
.S PSSXTEXT(PSSICT)="Unresolvable Gene: "_$S($P($G(PSSRESUL(PSSINLP,"GENE")),"^")'="NULL":$P($G(PSSRESUL(PSSINLP,"GENE")),"^"),1:"") D ADD
.D COMM
S PSSINLP="" F S PSSINLP=$O(PSSINV("P",PSSINLP)) Q:'PSSINLP D
.D ADDLN
.S PSSXTEXT(PSSICT)="The following Patient Specific Phenotype that is available for use in the PGx Order Check could not be found in the Phenotype file in Vista:"
.D ADDLN
.S PSSXTEXT(PSSICT)="Unresolvable Phenotype: "_$S($P($G(PSSRESUL(PSSINLP,"PHENOTYPE")),"^")'="NULL":$P($G(PSSRESUL(PSSINLP,"PHENOTYPE")),"^"),1:"") D ADD
.S PSSXTEXT(PSSICT)="Gene: "_$P($G(PSSRESUL(PSSINLP,"GENE")),"^") D ADD
.D COMM
D WRT^PSSPGXU2(.PSSELOG,PSSDFN,$G(PSSGNPH(1,"FULL_ICN")))
S XMTEXT="PSSXTEXT("
S XMY("VHAPBMCDSPGX@domain.ext")=""
N DIFROM,DUZ D ^XMD
Q
;
COMM ;
NEW PSSEDT,PSSGENEX,PSSPTPEX,PSSICN,PSSRDT,PSSPGXID,PSSLOC,PSSX,PSSGPFLG,PSSPKG,PSSGENEZ,PSSTENEZ
S PSSX=$G(PSSRESUL(PSSINLP,"GENE"))
S PSSGENE=$P(PSSX,"^"),PSSGENEZ=$P(PSSX,"^",3)
S PSSGENEX=$S(+$P(PSSX,"^",3):$P(PSSX,"^"),1:"")
S PSSX=$G(PSSRESUL(PSSINLP,"PHENOTYPE"))
S PSSPTYPE=$P(PSSX,"^"),PSSTENEZ=$P(PSSX,"^",3)
S PSSPTPEX=$S(+$P(PSSX,"^",3):$P(PSSX,"^"),1:"")
S PSSEDT=$$EMAILDT^PSSPGXU2(PSSDFN,PSSGENEX,PSSPTPEX)
S PSSICN=$G(PSSGNPH(PSSINLP,"FULL_ICN"))
S PSSRDT=$G(PSSGNPH(PSSINLP,"RESULT_DATE"))
S PSSPGXID=$G(PSSGNPH(PSSINLP,"PGXSID"))
S PSSLOC=$P(PSSPGXST,"^",2)_" "_$P(PSSPGXST,"^",3)
;
S PSSXTEXT(PSSICT)="Patient ICN: "_PSSICN D ADD
S PSSXTEXT(PSSICT)="Result Date: "_PSSRDT D ADD
S:PSSEDT]"" PSSXTEXT(PSSICT)="Previous Email sent on: "_PSSEDT D ADD
S PSSXTEXT(PSSICT)="pgxSID: "_PSSPGXID D ADD
S PSSXTEXT(PSSICT)="Location: "_PSSLOC D ADD
;Save data for ^PS(51.29 file
;P1=PHENOTYPE, P2=UNRESOLVED FLAG, P3=EMAIL DATE, P4=LOCATION, P5=PACKAGE
S PSSGPFLG=$S($G(PSSGENEZ)&($G(PSSTENEZ)):"B",$G(PSSTENEZ):"P",1:"G")
S PSSPKG=$S($G(XQY0)["PSO":"O",$G(XQY0)["PSJ":"I",$G(XQY0)["OR CPRS":"C",1:"")
S PSSELOG(PSSGENE)=$S(PSSGPFLG="G":"",1:PSSPTYPE)_"^"_PSSGPFLG_"^"_DT_"^"_PSSLOC_"^"_PSSPKG
Q
;
ADD ;
S PSSICT=PSSICT+1
Q
;
ADDLN ;
S PSSICT=PSSICT+1
S PSSXTEXT(PSSICT)=""
S PSSICT=PSSICT+1
Q
;
ERR ; Check for HDR & Vender errors
N PSSERRDR,PSSEL,PSSELCT,PSSELDNM,PSSTEMPX,PSSXL,PSSXCT,PSSACT
I $G(PSSHDRFG),$G(PSSFDBFG) D NOCONN Q
I $G(PSSHDRFG) D HDRERR
I $G(PSSFDBFG) D FDBERR
Q
;
SETDGR ;Set drugGeneReference data for Additional Information output
S PSSPH6="" F S PSSPH6=$O(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH5,"C",PSSPH6)) Q:PSSPH6="" D
.S PSSCAT2=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH5,"C",PSSPH6))
.I PSSCAT2="title" S PSSXDATA("TITLE")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="typeDescription" S PSSXDATA("TYPE")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="author" S PSSXDATA("AUTHOR")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="name" S PSSXDATA("NAME")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="location" S PSSXDATA("LOCATION")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="issueDate" S PSSXDATA("ISSUEDT")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="volume" S PSSXDATA("VOLUME")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="issue" S PSSXDATA("ISSUE")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="page" S PSSXDATA("PAGE")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="pubMedId" S PSSXDATA("PUBMEDID")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
.I PSSCAT2="url" S PSSXDATA("URL")=$G(^TMP("PSSPGXBS",$J,PSSPH1,PSSPH6,"T",1))
Q
;
HDRERR ;Unable to retrieve Lab results from the HDR
S PSSACT="ERROR",(PSSXL,PSSXCT)=1
S PSSTEMPX="Please perform a manual PGx Order check by using the Check Pharmacogenomic Interaction option for "
D SETERR(PSSTEMPX,PSSACT,.PSSXCT,.PSSXL)
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Reason(s): Pharmacogenomic Lab Data could not be retrieved at this time." D INC^PSSPGXPR
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
Q
;
FDBERR ;Unexpected error from vendor database
S PSSACT="ERROR"
S PSSXCT=$G(PSSXCT)+1,PSSXL=1
S PSSTEMPX="Pharmacogenomic Order Checks cannot be performed for "
D SETERR(PSSTEMPX,PSSACT,.PSSXCT,.PSSXL)
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Reason(s): "_$S(PSSFDBFG=1:"Vendor database cannot be reached.",1:"An unexpected error has occurred.") D INC^PSSPGXPR
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="" D INC^PSSPGXPR
I '$G(PSSHDRFG) D GENETBL^PSSPGX(.PSSGDT),LABRSLT
Q
;
SETERR(PSSTEMPX,PSSACT,PSSXCT,PSSXL) ;Unable to retrieve Lab results from the HDR
Q:$G(PSSTEMPX)=""
S:'+$G(PSSXCT) PSSXCT=1
S:'+$G(PSSXL) PSSXL=1
S:$G(PSSACT)="" PSSACT="ERROR"
S PSSTEMPX=$$DRGLST(PSSTEMPX)
D FORMAT(PSSTEMPX)
Q
FORMAT(X) ;
N PSSW1,PSSW2,PSSQLC
S DIWL=1,DIWR=79,DIWF="" I $G(PSSQLRF) S DIWR=55
K ^UTILITY($J,"W")
D ^DIWP
S PSSW1="" F S PSSW1=$O(^UTILITY($J,"W",PSSW1)) Q:PSSW1="" D
.S PSSW2="" F S PSSW2=$O(^UTILITY($J,"W",PSSW1,PSSW2)) Q:PSSW2="" D
..S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$G(^UTILITY($J,"W",PSSW1,PSSW2,0)) D INC^PSSPGXPR
K ^UTILITY($J,"W"),PSSTEMPX
Q
;
DRGLST(PSSTEMPX) ;Compile drug names for into text
NEW PSSELCT,PSSELDNM,PSSERRDR
S PSSELCT=0 S (PSSERRDR,PSSEL)="" F S PSSEL=$O(PSSPGXDG(PSSEL)) Q:PSSEL="" D
.S PSSELDNM=$G(PSSPGXDG(PSSEL,"DRUGNAME"))
.I PSSELDNM'="" S PSSELCT=PSSELCT+1,PSSERRDR=$S(PSSELCT=1:PSSELDNM,1:PSSERRDR_", "_PSSELDNM)
S PSSTEMPX=$G(PSSTEMPX)_$S(PSSELCT<2:"Drug: ",1:"Drugs: ")_PSSERRDR
Q PSSTEMPX
;
LABRSLT ;Set PGx lab result in ^TMP
NEW PSSCNT
I '+$G(PSSOPTFG) D
. S:'$D(PSSGTBL) ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="Patient has no pharmacogenomic lab results" D INC^PSSPGXPR
. I $D(PSSGTBL) F PSSCNT=0:0 S PSSCNT=$O(PSSGTBL(PSSCNT)) Q:'PSSCNT D
.. S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=PSSGTBL(PSSCNT) D INC^PSSPGXPR
. S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="" D INC^PSSPGXPR
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="For more details on VA National Pharmacogenomic Program go to:" D INC^PSSPGXPR
S:$G(PSSURL)="" PSSURL=$P($G(^PS(59.7,1,"PGX")),"^")
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=PSSURL D INC^PSSPGXPR
Q
;
NOCONN ;Both HDR & FDB are not connecting
S PSSACT="ERROR"
S PSSXCT=$G(PSSXCT)+1,PSSXL=1
S PSSTEMPX="Pharmacogenomic Order Checks cannot be performed for "
D SETERR(PSSTEMPX,PSSACT,.PSSXCT,.PSSXL)
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Reason(s): Pharmacogenomic Lab Data could not be retrieved at this time." D INC^PSSPGXPR
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Vendor database cannot be reached." ;D INC^PSSPGXPR
Q
;
PGXCHK() ; check pgx called from PSSHRIT - pss*1*262
; Return 1 if OK, 0 if not OK.
N VAL,DRGIEN,GENE,INFO,INTRO,BASE,DRUG,DRGNM,GENES,X1,PSSDS1,PSSDX,PSSDXC
N PSSLEFT S PSSLEFT=4 ; left margin for results
;
S DRGNM="CLOPIDOGREL BISULFATE 75MG TAB"
S GENE="CYP2C19",PSSDXC=1
;
S BASE=$T(+0)_" PGXCHK"
S GENES(GENE,"GENE")="",GENES(GENE,"PHENOTYPE")="INTERMEDIATE METABOLIZER"
S X1(1,"DRUGNAME")=DRGNM
S X1(1,"GCN")=38164
S X1(1,"VUID")=4013159
D PGXMAIN^PSSPGX1(.BASE,.GENES,.X1)
;
S INTRO="Performing Pharmacogenomic Order Check for "_GENE_" intermediate metabolizer and "_$G(DRGNM)
S INTRO=INTRO_$S('$D(^TMP($J,"PSSXWARN","ERROR"))&($D(^TMP($J,"PSSXWARN"))):"...OK",1:"...Not OK")
;
I $D(^TMP($J,"PSSXWARN","ERROR")) D
.D OUTPUT^PSSHRIT(INTRO)
.W ! D OUTPUT^PSSHRIT("Pharmacogenomic Order Check could not be performed.",PSSLEFT)
E D
.D OUTPUT^PSSHRIT(INTRO)
.S PSSDS1="" F S PSSDS1=$O(^TMP($J,"PSSXWARN",PSSDS1)) Q:PSSDS1="" D
..S PSSDX="" F S PSSDX=$O(^TMP($J,"PSSXWARN",PSSDS1,PSSDX)) Q:PSSDX="" D
...F S PSSDXC=$O(^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)) Q:'PSSDXC!(^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)["For more details") D
....I ^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)="" K ^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)
....E I ^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)["MONITORING" W !!,^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)
....E I ^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)'[" " W !,^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)
.W !
Q $S($D(^TMP($J,"PSSXWARN","ERROR")):0,1:1)
;
URL ;Set URL info for PGx check
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="For more details on VA National Pharmacogenomics Program go to:" D INC^PSSPGXPR
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$S($G(PSSURL)]"":PSSURL,1:$P($G(^PS(59.7,1,"PGX")),"^")) D INC^PSSPGXPR
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="" D INC^PSSPGXPR
Q
;
SUPP() ;Suppress if disabled in CPRS - called from PSSPGXPR
S PSSSUPFL=0 D I PSSSUPFL Q 1
.I $G(PSSORSUP)="H",$G(PSSTCNTV)="Interruptive" S PSSSUPFL=1 Q
.I $G(PSSORSUP)="M",$G(PSSTCNTV)="Informational" S PSSSUPFL=1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPGXUT 11217 printed Mar 25, 2026@15:58:18 Page 2
PSSPGXUT ;BIR/RTR - PHARMACOGENOMICS UTILITY ROUTINE ;09/20/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
+2 ;
DATA(PSSGNPH,PSSRESUL) ;Validate HDR Gene and Phenotype data to send to vendor
+1 ;PSSRESUL(N, "GENE") = Gene from HDR ^ Vendor mapped Gene ^ 1 if not map
+2 ;PSSRESUL(N, "PHENOTYPE") = Pheno type from HDR ^ Vendor mapped Phenotype ^ 1 if not map
+3 NEW PSSGNDAT,PSSPHDAT,PSSCTR,PSSINV,PSSELOG,PSSNOFDB
+4 SET PSSCTR=""
FOR
SET PSSCTR=$ORDER(PSSGNPH(PSSCTR))
if 'PSSCTR
QUIT
Begin DoDot:1
+5 SET PSSGNDAT=$GET(PSSGNPH(PSSCTR,"GENE"))
SET PSSPHDAT=$GET(PSSGNPH(PSSCTR,"PHENOTYPE"))
+6 if PSSGNDAT=""
SET PSSGNDAT="NULL"
if PSSPHDAT=""
SET PSSPHDAT="NULL"
+7 SET PSSRESUL(PSSCTR,"GENE")=PSSGNDAT_"^"_$$GENE(PSSGNDAT)
+8 SET PSSRESUL(PSSCTR,"PHENOTYPE")=PSSPHDAT_"^"_$$PHEN(PSSPHDAT)
IF PSSNOFDB
SET PSSRESUL(PSSCTR,"NOFDB")=""
End DoDot:1
+9 IF '$DATA(PSSINV)
QUIT
+10 DO MESS
+11 QUIT
+12 ;
GENE(PSSGNE) ;Find vendor gene equivalent
+1 ;PSSGRSLT=GENE^FLAG(if can't map)
+2 NEW PSSCR,PSSGIEN,PSSGRSLT,PSSGNEC
+3 SET PSSGIEN=0
+4 IF $GET(PSSGNE)="NULL"
SET PSSINV("G",PSSCTR)=""
QUIT $GET(PSSGNE)_"^1"
+5 SET PSSGNEC=$$UP^XLFSTR(PSSGNE)
+6 FOR PSSCR="C","B","D"
if PSSGIEN
QUIT
SET PSSGIEN=$ORDER(^PS(51.26,PSSCR,PSSGNEC,0))
+7 IF 'PSSGIEN
SET PSSINV("G",PSSCTR)=""
QUIT $GET(PSSGNE)_"^1"
+8 SET PSSGRSLT=$PIECE($GET(^PS(51.26,PSSGIEN,0)),"^",2)
IF PSSGRSLT=""
SET PSSINV("G",PSSCTR)=""
QUIT $GET(PSSGNE)_"^1"
+9 QUIT PSSGRSLT_"^"
+10 ;
PHEN(PSSPNT) ;Find vendor phenotype equivalent
+1 ;PSSPRSLT=PHENO^FLAG(if can't map)
+2 NEW PSSCRT,PSSPIEN,PSSPRSLT,PSSPNTC
+3 SET (PSSPIEN,PSSNOFDB)=0
+4 IF $GET(PSSPNT)="NULL"
SET PSSINV("P",PSSCTR)=""
QUIT $GET(PSSPNT)_"^1"
+5 SET PSSPNTC=$$UP^XLFSTR(PSSPNT)
+6 FOR PSSCRT="C","B","D"
if PSSPIEN
QUIT
SET PSSPIEN=$ORDER(^PS(51.28,PSSCRT,PSSPNTC,0))
+7 IF 'PSSPIEN
SET PSSINV("P",PSSCTR)=""
QUIT $GET(PSSPNT)_"^1"
+8 SET PSSPRSLT=$PIECE($GET(^PS(51.28,PSSPIEN,0)),"^",2)
IF PSSPRSLT=""
SET PSSINV("P",PSSCTR)=""
SET PSSNOFDB=1
QUIT $GET(PSSPNT)_"^1"
+9 QUIT PSSPRSLT_"^"
+10 ;
MESS ;Send message of unresolvable genes/phenotypes to Pharmacy Benefits Management
+1 NEW PSSPGXST,PSSINLP,PSSICT,PSSXTEXT,XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
+2 if '$$PGXEMAIL^PSSPGXU2(PSSDFN,PSSICN,.PSSRESUL,.PSSINV)
QUIT
+3 SET PSSPGXST=$$SITE^VASITE
SET PSSICT=1
+4 SET XMDUZ="UNRESOLVABLE PGX DATA"
+5 SET XMSUB="UNRESOLVABLE PGX DATA FROM "_$PIECE(PSSPGXST,"^",2)_" "_$PIECE(PSSPGXST,"^",3)
+6 SET PSSINLP=""
FOR
SET PSSINLP=$ORDER(PSSINV("G",PSSINLP))
if 'PSSINLP
QUIT
Begin DoDot:1
+7 DO ADDLN
+8 SET PSSXTEXT(PSSICT)="The following Patient Specific Gene that is available for use in the PGx Order Check could not be found in the Gene file in Vista:"
+9 DO ADDLN
+10 SET PSSXTEXT(PSSICT)="Unresolvable Gene: "_$SELECT($PIECE($GET(PSSRESUL(PSSINLP,"GENE")),"^")'="NULL":$PIECE($GET(PSSRESUL(PSSINLP,"GENE")),"^"),1:"")
DO ADD
+11 DO COMM
End DoDot:1
+12 SET PSSINLP=""
FOR
SET PSSINLP=$ORDER(PSSINV("P",PSSINLP))
if 'PSSINLP
QUIT
Begin DoDot:1
+13 DO ADDLN
+14 SET PSSXTEXT(PSSICT)="The following Patient Specific Phenotype that is available for use in the PGx Order Check could not be found in the Phenotype file in Vista:"
+15 DO ADDLN
+16 SET PSSXTEXT(PSSICT)="Unresolvable Phenotype: "_$SELECT($PIECE($GET(PSSRESUL(PSSINLP,"PHENOTYPE")),"^")'="NULL":$PIECE($GET(PSSRESUL(PSSINLP,"PHENOTYPE")),"^"),1:"")
DO ADD
+17 SET PSSXTEXT(PSSICT)="Gene: "_$PIECE($GET(PSSRESUL(PSSINLP,"GENE")),"^")
DO ADD
+18 DO COMM
End DoDot:1
+19 DO WRT^PSSPGXU2(.PSSELOG,PSSDFN,$GET(PSSGNPH(1,"FULL_ICN")))
+20 SET XMTEXT="PSSXTEXT("
+21 SET XMY("VHAPBMCDSPGX@domain.ext")=""
+22 NEW DIFROM,DUZ
DO ^XMD
+23 QUIT
+24 ;
COMM ;
+1 NEW PSSEDT,PSSGENEX,PSSPTPEX,PSSICN,PSSRDT,PSSPGXID,PSSLOC,PSSX,PSSGPFLG,PSSPKG,PSSGENEZ,PSSTENEZ
+2 SET PSSX=$GET(PSSRESUL(PSSINLP,"GENE"))
+3 SET PSSGENE=$PIECE(PSSX,"^")
SET PSSGENEZ=$PIECE(PSSX,"^",3)
+4 SET PSSGENEX=$SELECT(+$PIECE(PSSX,"^",3):$PIECE(PSSX,"^"),1:"")
+5 SET PSSX=$GET(PSSRESUL(PSSINLP,"PHENOTYPE"))
+6 SET PSSPTYPE=$PIECE(PSSX,"^")
SET PSSTENEZ=$PIECE(PSSX,"^",3)
+7 SET PSSPTPEX=$SELECT(+$PIECE(PSSX,"^",3):$PIECE(PSSX,"^"),1:"")
+8 SET PSSEDT=$$EMAILDT^PSSPGXU2(PSSDFN,PSSGENEX,PSSPTPEX)
+9 SET PSSICN=$GET(PSSGNPH(PSSINLP,"FULL_ICN"))
+10 SET PSSRDT=$GET(PSSGNPH(PSSINLP,"RESULT_DATE"))
+11 SET PSSPGXID=$GET(PSSGNPH(PSSINLP,"PGXSID"))
+12 SET PSSLOC=$PIECE(PSSPGXST,"^",2)_" "_$PIECE(PSSPGXST,"^",3)
+13 ;
+14 SET PSSXTEXT(PSSICT)="Patient ICN: "_PSSICN
DO ADD
+15 SET PSSXTEXT(PSSICT)="Result Date: "_PSSRDT
DO ADD
+16 if PSSEDT]""
SET PSSXTEXT(PSSICT)="Previous Email sent on: "_PSSEDT
DO ADD
+17 SET PSSXTEXT(PSSICT)="pgxSID: "_PSSPGXID
DO ADD
+18 SET PSSXTEXT(PSSICT)="Location: "_PSSLOC
DO ADD
+19 ;Save data for ^PS(51.29 file
+20 ;P1=PHENOTYPE, P2=UNRESOLVED FLAG, P3=EMAIL DATE, P4=LOCATION, P5=PACKAGE
+21 SET PSSGPFLG=$SELECT($GET(PSSGENEZ)&($GET(PSSTENEZ)):"B",$GET(PSSTENEZ):"P",1:"G")
+22 SET PSSPKG=$SELECT($GET(XQY0)["PSO":"O",$GET(XQY0)["PSJ":"I",$GET(XQY0)["OR CPRS":"C",1:"")
+23 SET PSSELOG(PSSGENE)=$SELECT(PSSGPFLG="G":"",1:PSSPTYPE)_"^"_PSSGPFLG_"^"_DT_"^"_PSSLOC_"^"_PSSPKG
+24 QUIT
+25 ;
ADD ;
+1 SET PSSICT=PSSICT+1
+2 QUIT
+3 ;
ADDLN ;
+1 SET PSSICT=PSSICT+1
+2 SET PSSXTEXT(PSSICT)=""
+3 SET PSSICT=PSSICT+1
+4 QUIT
+5 ;
ERR ; Check for HDR & Vender errors
+1 NEW PSSERRDR,PSSEL,PSSELCT,PSSELDNM,PSSTEMPX,PSSXL,PSSXCT,PSSACT
+2 IF $GET(PSSHDRFG)
IF $GET(PSSFDBFG)
DO NOCONN
QUIT
+3 IF $GET(PSSHDRFG)
DO HDRERR
+4 IF $GET(PSSFDBFG)
DO FDBERR
+5 QUIT
+6 ;
SETDGR ;Set drugGeneReference data for Additional Information output
+1 SET PSSPH6=""
FOR
SET PSSPH6=$ORDER(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH5,"C",PSSPH6))
if PSSPH6=""
QUIT
Begin DoDot:1
+2 SET PSSCAT2=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH5,"C",PSSPH6))
+3 IF PSSCAT2="title"
SET PSSXDATA("TITLE")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+4 IF PSSCAT2="typeDescription"
SET PSSXDATA("TYPE")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+5 IF PSSCAT2="author"
SET PSSXDATA("AUTHOR")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+6 IF PSSCAT2="name"
SET PSSXDATA("NAME")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+7 IF PSSCAT2="location"
SET PSSXDATA("LOCATION")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+8 IF PSSCAT2="issueDate"
SET PSSXDATA("ISSUEDT")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+9 IF PSSCAT2="volume"
SET PSSXDATA("VOLUME")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+10 IF PSSCAT2="issue"
SET PSSXDATA("ISSUE")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+11 IF PSSCAT2="page"
SET PSSXDATA("PAGE")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+12 IF PSSCAT2="pubMedId"
SET PSSXDATA("PUBMEDID")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
+13 IF PSSCAT2="url"
SET PSSXDATA("URL")=$GET(^TMP("PSSPGXBS",$JOB,PSSPH1,PSSPH6,"T",1))
End DoDot:1
+14 QUIT
+15 ;
HDRERR ;Unable to retrieve Lab results from the HDR
+1 SET PSSACT="ERROR"
SET (PSSXL,PSSXCT)=1
+2 SET PSSTEMPX="Please perform a manual PGx Order check by using the Check Pharmacogenomic Interaction option for "
+3 DO SETERR(PSSTEMPX,PSSACT,.PSSXCT,.PSSXL)
+4 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Reason(s): Pharmacogenomic Lab Data could not be retrieved at this time."
DO INC^PSSPGXPR
+5 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
+6 QUIT
+7 ;
FDBERR ;Unexpected error from vendor database
+1 SET PSSACT="ERROR"
+2 SET PSSXCT=$GET(PSSXCT)+1
SET PSSXL=1
+3 SET PSSTEMPX="Pharmacogenomic Order Checks cannot be performed for "
+4 DO SETERR(PSSTEMPX,PSSACT,.PSSXCT,.PSSXL)
+5 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Reason(s): "_$SELECT(PSSFDBFG=1:"Vendor database cannot be reached.",1:"An unexpected error has occurred.")
DO INC^PSSPGXPR
+6 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
DO INC^PSSPGXPR
+7 IF '$GET(PSSHDRFG)
DO GENETBL^PSSPGX(.PSSGDT)
DO LABRSLT
+8 QUIT
+9 ;
SETERR(PSSTEMPX,PSSACT,PSSXCT,PSSXL) ;Unable to retrieve Lab results from the HDR
+1 if $GET(PSSTEMPX)=""
QUIT
+2 if '+$GET(PSSXCT)
SET PSSXCT=1
+3 if '+$GET(PSSXL)
SET PSSXL=1
+4 if $GET(PSSACT)=""
SET PSSACT="ERROR"
+5 SET PSSTEMPX=$$DRGLST(PSSTEMPX)
+6 DO FORMAT(PSSTEMPX)
+7 QUIT
FORMAT(X) ;
+1 NEW PSSW1,PSSW2,PSSQLC
+2 SET DIWL=1
SET DIWR=79
SET DIWF=""
IF $GET(PSSQLRF)
SET DIWR=55
+3 KILL ^UTILITY($JOB,"W")
+4 DO ^DIWP
+5 SET PSSW1=""
FOR
SET PSSW1=$ORDER(^UTILITY($JOB,"W",PSSW1))
if PSSW1=""
QUIT
Begin DoDot:1
+6 SET PSSW2=""
FOR
SET PSSW2=$ORDER(^UTILITY($JOB,"W",PSSW1,PSSW2))
if PSSW2=""
QUIT
Begin DoDot:2
+7 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$GET(^UTILITY($JOB,"W",PSSW1,PSSW2,0))
DO INC^PSSPGXPR
End DoDot:2
End DoDot:1
+8 KILL ^UTILITY($JOB,"W"),PSSTEMPX
+9 QUIT
+10 ;
DRGLST(PSSTEMPX) ;Compile drug names for into text
+1 NEW PSSELCT,PSSELDNM,PSSERRDR
+2 SET PSSELCT=0
SET (PSSERRDR,PSSEL)=""
FOR
SET PSSEL=$ORDER(PSSPGXDG(PSSEL))
if PSSEL=""
QUIT
Begin DoDot:1
+3 SET PSSELDNM=$GET(PSSPGXDG(PSSEL,"DRUGNAME"))
+4 IF PSSELDNM'=""
SET PSSELCT=PSSELCT+1
SET PSSERRDR=$SELECT(PSSELCT=1:PSSELDNM,1:PSSERRDR_", "_PSSELDNM)
End DoDot:1
+5 SET PSSTEMPX=$GET(PSSTEMPX)_$SELECT(PSSELCT<2:"Drug: ",1:"Drugs: ")_PSSERRDR
+6 QUIT PSSTEMPX
+7 ;
LABRSLT ;Set PGx lab result in ^TMP
+1 NEW PSSCNT
+2 IF '+$GET(PSSOPTFG)
Begin DoDot:1
+3 if '$DATA(PSSGTBL)
SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="Patient has no pharmacogenomic lab results"
DO INC^PSSPGXPR
+4 IF $DATA(PSSGTBL)
FOR PSSCNT=0:0
SET PSSCNT=$ORDER(PSSGTBL(PSSCNT))
if 'PSSCNT
QUIT
Begin DoDot:2
+5 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=PSSGTBL(PSSCNT)
DO INC^PSSPGXPR
End DoDot:2
+6 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
DO INC^PSSPGXPR
End DoDot:1
+7 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="For more details on VA National Pharmacogenomic Program go to:"
DO INC^PSSPGXPR
+8 if $GET(PSSURL)=""
SET PSSURL=$PIECE($GET(^PS(59.7,1,"PGX")),"^")
+9 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=PSSURL
DO INC^PSSPGXPR
+10 QUIT
+11 ;
NOCONN ;Both HDR & FDB are not connecting
+1 SET PSSACT="ERROR"
+2 SET PSSXCT=$GET(PSSXCT)+1
SET PSSXL=1
+3 SET PSSTEMPX="Pharmacogenomic Order Checks cannot be performed for "
+4 DO SETERR(PSSTEMPX,PSSACT,.PSSXCT,.PSSXL)
+5 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Reason(s): Pharmacogenomic Lab Data could not be retrieved at this time."
DO INC^PSSPGXPR
+6 ;D INC^PSSPGXPR
SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" Vendor database cannot be reached."
+7 QUIT
+8 ;
PGXCHK() ; check pgx called from PSSHRIT - pss*1*262
+1 ; Return 1 if OK, 0 if not OK.
+2 NEW VAL,DRGIEN,GENE,INFO,INTRO,BASE,DRUG,DRGNM,GENES,X1,PSSDS1,PSSDX,PSSDXC
+3 ; left margin for results
NEW PSSLEFT
SET PSSLEFT=4
+4 ;
+5 SET DRGNM="CLOPIDOGREL BISULFATE 75MG TAB"
+6 SET GENE="CYP2C19"
SET PSSDXC=1
+7 ;
+8 SET BASE=$TEXT(+0)_" PGXCHK"
+9 SET GENES(GENE,"GENE")=""
SET GENES(GENE,"PHENOTYPE")="INTERMEDIATE METABOLIZER"
+10 SET X1(1,"DRUGNAME")=DRGNM
+11 SET X1(1,"GCN")=38164
+12 SET X1(1,"VUID")=4013159
+13 DO PGXMAIN^PSSPGX1(.BASE,.GENES,.X1)
+14 ;
+15 SET INTRO="Performing Pharmacogenomic Order Check for "_GENE_" intermediate metabolizer and "_$GET(DRGNM)
+16 SET INTRO=INTRO_$SELECT('$DATA(^TMP($JOB,"PSSXWARN","ERROR"))&($DATA(^TMP($JOB,"PSSXWARN"))):"...OK",1:"...Not OK")
+17 ;
+18 IF $DATA(^TMP($JOB,"PSSXWARN","ERROR"))
Begin DoDot:1
+19 DO OUTPUT^PSSHRIT(INTRO)
+20 WRITE !
DO OUTPUT^PSSHRIT("Pharmacogenomic Order Check could not be performed.",PSSLEFT)
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 DO OUTPUT^PSSHRIT(INTRO)
+23 SET PSSDS1=""
FOR
SET PSSDS1=$ORDER(^TMP($JOB,"PSSXWARN",PSSDS1))
if PSSDS1=""
QUIT
Begin DoDot:2
+24 SET PSSDX=""
FOR
SET PSSDX=$ORDER(^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX))
if PSSDX=""
QUIT
Begin DoDot:3
+25 FOR
SET PSSDXC=$ORDER(^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC))
if 'PSSDXC!(^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)["For more details")
QUIT
Begin DoDot:4
+26 IF ^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)=""
KILL ^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)
+27 IF '$TEST
IF ^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)["MONITORING"
WRITE !!,^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)
+28 IF '$TEST
IF ^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)'[" "
WRITE !,^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)
End DoDot:4
End DoDot:3
End DoDot:2
+29 WRITE !
End DoDot:1
+30 QUIT $SELECT($DATA(^TMP($JOB,"PSSXWARN","ERROR")):0,1:1)
+31 ;
URL ;Set URL info for PGx check
+1 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="For more details on VA National Pharmacogenomics Program go to:"
DO INC^PSSPGXPR
+2 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$SELECT($GET(PSSURL)]"":PSSURL,1:$PIECE($GET(^PS(59.7,1,"PGX")),"^"))
DO INC^PSSPGXPR
+3 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
DO INC^PSSPGXPR
+4 QUIT
+5 ;
SUPP() ;Suppress if disabled in CPRS - called from PSSPGXPR
+1 SET PSSSUPFL=0
Begin DoDot:1
+2 IF $GET(PSSORSUP)="H"
IF $GET(PSSTCNTV)="Interruptive"
SET PSSSUPFL=1
QUIT
+3 IF $GET(PSSORSUP)="M"
IF $GET(PSSTCNTV)="Informational"
SET PSSSUPFL=1
End DoDot:1
IF PSSSUPFL
QUIT 1
+4 QUIT 0
