PSSPGXTS ;BIR/RTR - PHARMACOGENOMICS TEST OPTION ;09/20/07
;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
;
EN ;
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DLAYGO,PSSLTXT,PSSGENE,PSSVAR1,PSSVAR2,PSSGCT,PSSPGXRS,PSSPGXDC,PSSLOC,PSSLOCNM,PSSVAR4,PSSDRGCT,PSSERRG1,PSSERRG2,PSSERRG3,PSSERRG4,PSSERRG5,PSSERRG6,PSSERRG7,PSSERRGN,PSSERRGL
N PSSPGXQT,PSSPGXDG,PSSPGXND,PSSPPROD,PSSDF1C,PSSGAR,PSSGLP,PSS50IEN,PSSDISPD,PSSDISPG,PSSPGXSV,PSSPGXAR,PSSPHAR,PSSPGXVA,PSSGLPH,PSSFDBFG,PSSOPTFG,PSSGTYPE,PSSLFEED,PSSGLOOP,PSSGVAL,PSSGVALT,PSSPHEN,PSSSCORE,PSSPGEND
N PSSPDRUG,PSSASKQT,PSSTESTP,PSSGENES,PSSPERR,PSSNOADD,PSSLOCZZ,PSSPHDT
W @IOF,!!," PHARMACOGENOMIC (PGx) TEST OPTION",!
EN3 ;restart after exit from Patient prompt
S (PSSASKQT,PSSTESTP,PSSPDRUG,PSSGLOOP)=0
S PSSPGEND=$$ASK^PSSPGXT1()
I PSSASKQT W ! Q
I 'PSSPGEND G EN1
EN4 ;restart after exit from any prompt past patient prompt
W ! D ASKPT^PSSPGXT1 I 'PSSTESTP W !! K PSSPGEND G EN3
D DISP^PSSPGXT1 I PSSASKQT D RESET^PSSPGXT1 G EN4
D ASKDR^PSSPGXT1 I PSSASKQT D RESET^PSSPGXT1 G EN4
;
EN1 ;
I $G(PSSDRGCT) W @IOF
S (PSSDF1C,PSSPGXQT,PSSGCT,PSSDRGCT,PSSLFEED)=0
K PSSGAR,PSSGENE,PSSPGXAR
I '$G(PSSPGEND) K PSSPGXDG,PSSPGXVA,PSSLOCNM
K ^TMP("PSSPGXBS",$J),^TMP("PSSXWARN",$J)
I '$G(PSSNOADD) D DRUG
I '$D(PSSPGXDG),$G(PSSPGEND) D RESET^PSSPGXT1 G EN4
I '$D(PSSPGXDG) W ! K PSSPHDT Q
I PSSPGEND,$D(PSSGENES) D CONV^PSSPGXT1 G EN2
D GENE
W ! S PSSGLP="" F S PSSGLP=$O(PSSGAR(PSSGLP)) Q:PSSGLP=""!(PSSPGXQT) D
.S PSSGCT=PSSGCT+1
.S PSSGENE(PSSGLP,"GENE")=""
.S PSSGENE(PSSGLP,"GENOTYPE")=$$GENOTP()
.S PSSGENE(PSSGLP,"ACTIVITY_SCORE")=$$ACTSCR^PSSPGXT1()
.S PSSGENE(PSSGLP,"PHENOTYPE")=$$PHENOTP(PSSGLP)
.W !!,?3,"Gene: "_PSSGLP,!,?3,"Genotype: "_$G(PSSGENE(PSSGLP,"GENOTYPE")),!,?3,"Activity Score: "_$G(PSSGENE(PSSGLP,"ACTIVITY_SCORE")),!,?3,"Phenotype: "_$G(PSSGENE(PSSGLP,"PHENOTYPE"))
.K DIR W ! S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y"
.S DIR("?",1)="Enter 'Y' for Yes, 'N' for No, '^' to exit entire gene selection list." D ^DIR S PSSLFEED=1
.I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSSPGXQT=1 Q
.I Y S PSSPGXSV=PSSGLP Q
.K PSSGENE(PSSGLP) S PSSGLP=$S(PSSGCT=1:"",1:PSSPGXSV) I PSSGCT=1 S PSSGCT=0
EN2 ;
K PSSGENES
I PSSPGXQT,$G(PSSPGEND) D RESET^PSSPGXT1 G EN4
I PSSPGXQT W ! G EN1
S PSSVAR1="PSSPGXBS",PSSVAR4="PSSPGXOT"
D PGXOPT^PSSPGX(.PSSVAR1,.PSSPGXDG,.PSSGENE,.PSSVAR4) I +$G(PSSFDBFG) D ERR^PSSPGXUT
W @IOF
W !!,"Inputs:"
D PAUSE4 F PSSDISPD=0:0 S PSSDISPD=$O(PSSPGXDG(PSSDISPD)) Q:'PSSDISPD!(PSSPGXQT) D
.W !!,"Drug: "_$G(PSSPGXDG(PSSDISPD,"DRUGNAME")) D PAUSE4 Q:PSSPGXQT
.W !,"VA Product: "_$G(PSSPGXVA(PSSDISPD,"VAPROD")) D PAUSE4 Q:PSSPGXQT
.W !,"GCNSEQNO: "_$G(PSSPGXDG(PSSDISPD,"GCN")) D PAUSE4 Q:PSSPGXQT
D PAUSE4 S PSSDISPG="" F S PSSDISPG=$O(PSSGENE(PSSDISPG)) Q:PSSDISPG=""!(PSSPGXQT) D
.W !!,"Gene: "_PSSDISPG D PAUSE4 Q:PSSPGXQT
.W !,"Genotype: "_$G(PSSGENE(PSSDISPG,"GENOTYPE")) D PAUSE4 Q:PSSPGXQT
.W !,"Activity Score: "_$G(PSSGENE(PSSDISPG,"ACTIVITY_SCORE")) D PAUSE4 Q:PSSPGXQT
.W !,"Phenotype: "_$G(PSSGENE(PSSDISPG,"PHENOTYPE")) D PAUSE4 Q:PSSPGXQT
D PAUSE I PSSPGXQT W ! Q:PSSPGEND W ! G EN1
D GETD^PSSPGXPR,BADGCN,SETPGX,DISP K PSSPHAR D PAUSE3
K ^TMP("PSSPGXBS",$J),^TMP($J,"PSSXWARN")
I PSSPGEND D RESET^PSSPGXT1 G EN4
D RESET^PSSPGXT1 S PSSPGEND=0 G EN1
;
DRUG ;Drug selection
N PSSVAPGX,PSSPGXLG,PSSPRMD,PSSSELGC
D:'$G(PSSDRGCT) INTRO^PSSPGXT1 S PSSDRGCT=1
K DIC S DIC(0)="AEMQZ",DIC="^PSDRUG(",DIC("A")=$S('PSSDF1C:"Select DRUG: ",1:"Select Another DRUG: "),DIC("S")="I $P(^(0),""^"",3)'[""S""&($E($P(^(0),""^"",2),1,2)'=""XA"")" D ^DIC I Y<0 D:$D(PSSLOCNM) K PSSLOCZZ Q
.W !!?3,"Drugs Selected:" D AL^PSSPGXT1 S PSSPRMD="" F S PSSPRMD=$O(PSSLOCZZ(PSSPRMD)) Q:PSSPRMD="" W !?4,PSSPRMD
.D PAUSE2
S PSS50IEN=+Y
S PSSPGXND=$G(^PSDRUG(PSS50IEN,"ND")),PSSLOC=$P($G(^PSDRUG(PSS50IEN,0)),"^")
I '$P(PSSPGXND,"^")!('$P(PSSPGXND,"^",3)) D D PAUSE2 G DRUG
.W !!,"Drug is not matched to the National Drug File."
S PSSPPROD=$$PROD0^PSNAPIS($P(PSSPGXND,"^"),$P(PSSPGXND,"^",3))
I $P(PSSPPROD,"^",7)="" D D PAUSE2 G DRUG
.W !!,"Drug does not have a GCNSEQNO."
S PSSSELGC=+$P(PSSPPROD,"^",7)
S PSSVAPGX=$$PGX^PSNAPIS($P(PSSPGXND,"^"),$P(PSSPGXND,"^",3))
I '$G(PSSVAPGX) D D PAUSE2 G DRUG
.S PSSPGXLG=$L(PSSLOC)
.I PSSPGXLG<27 W !!,PSSLOC_" does not participate in Pharmacogenomic Order Checks." Q
.W !!,PSSLOC_" does not participate in",!,"Pharmacogenomic Order Checks."
S PSSDF1C=1
W !!?2,"VA PRODUCT: ",$P(PSSPPROD,"^"),!?2," GCNSEQNO: ",PSSSELGC,!
S PSSPGXDG(PSSSELGC,"GCN")=PSSSELGC
S PSSPGXVA(PSSSELGC,"VAPROD")=$P(PSSPPROD,"^")
S PSSPGXDG(PSSSELGC,"DRUGNAME")=$G(PSSLOC)
S PSSPGXDG(PSSSELGC,"VUID")=$$GETVUID^XTID(50.68,,$P(PSSPGXND,"^",3)_",")
S PSSLOCNM(PSSSELGC,"LOCNAME",PSSLOC)=""
G DRUG
Q
;
GENE ;Gene selection
N DIC,X,X,DINUM,DLAYGO,DUOUT,DTOUT,PSSPRM,PSSPRML
K PSSGAR
S PSSPRM=0
GENES ;
W ! S DIC=51.26,DIC(0)="QEAMZ",DIC("A")=$S(PSSPRM:"Select Another Gene: ",1:"Select Gene: ") D ^DIC I Y<0!($D(DUOUT))!($D(DTOUT)) D D:$D(PSSGAR) PAUSE2 Q
.I '$D(PSSGAR) W !!?3,"No Genes selected." Q
.W !!?3,"Genes Selected:" S PSSPRML="" F S PSSPRML=$O(PSSGAR(PSSPRML)) Q:PSSPRML="" W !?4,PSSPRML
I $D(PSSGAR($P(Y(0),"^"))) W !!?5,"Gene was previously selected." G GENES
S PSSGAR($P(Y(0),"^"))="",PSSPRM=1
G GENES
Q
;
GENOTP() ;Genotype selection
N PSSGVCT
K DIR S PSSGTYPE=""
I 'PSSGLOOP F PSSGVCT=1:1 Q:PSSGVCT>11 S PSSGVALT=$T(GDATA+PSSGVCT) S PSSGVAL($P(PSSGVALT,";;",2))=$P(PSSGVALT,";;",3)_";;"_$P(PSSGVALT,";;",4)
S PSSGLOOP=1
I PSSLFEED W !!
I $D(PSSGVAL(PSSGLP)) W !,"Examples: "_$P(PSSGVAL(PSSGLP),";;")_", or "_$P(PSSGVAL(PSSGLP),";;",2)_", etc.",!
S DIR("?")=" ",DIR("?",1)="Genotype is optional, leave blank if unknown. Answer must be 1-50 characters",DIR("?",2)="in length."
S DIR(0)="FO^1:50",DIR("A")="Genotype selection for "_PSSGLP_" (optional)" D ^DIR
I X=""!($D(DIRUT)) Q ""
S PSSGTYPE=X
Q PSSGTYPE
;
GDATA ;
;;ABCG2;;c.421C>A C/A;;c.421C>A C/C
;;CYP2C;;G.96405502G>A A/A;;G.96405502G>A G/G
;;CYP2C19;;*1/*1;;*2/*17
;;CYP2C9;;*1/*1;;*1/*2
;;CYP2D6;;*2/*4;;*1/*10
;;CYP3A5;;*1/*4;;*1/*3
;;CYP4F2;;C.1297G>A G/G;;C.1297G>A A/A
;;SLCO1B1;;*15/*15;;*1A/*1A
;;TPMT;;*2/*3A;;*1/*8
;;VKORC1;;-1639G>A G/G;;1639G>A G/A
;;UGT1A1;;*28/*28;;*1/*1
Q
;
PHENOTP(PSSGLPH) ;Phenotype selection
N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,PSSLP,PSSZ,PSSZZ,PSSCX,PSSPTYPE,PSSLPTX
N PSSGIEN,PSSGILP,PSSGIARR,PSSGISEL,PSSPGXQT,PSSGIPHN
S PSSPGXQT=0
W @IOF
W !!," Phenotype selection for "_PSSGLPH,!
S PSSGIEN=$O(^PS(51.26,"B",PSSGLPH,0)) I 'PSSGIEN W !!,"Unable to locate "_PSSGLPH_" to enable Phenotype selection.",! D PAUSE2 Q ""
S PSSGILP="" F S PSSGILP=$O(^PS(51.26,PSSGIEN,2,"B",PSSGILP)) Q:'PSSGILP D
.S PSSGIPHN=$P($G(^PS(51.28,PSSGILP,0)),"^") I PSSGIPHN'="" S PSSGIARR(PSSGIPHN)=""
I '$D(PSSGIARR) W !!,"There are no selectable phenotypes for "_PSSGLPH,! D PAUSE2 Q ""
S PSSLP=1 S PSSLPTX="" F S PSSLPTX=$O(PSSGIARR(PSSLPTX)) Q:PSSLPTX="" D
.S PSSGISEL(PSSLP)=PSSLPTX,PSSLP=PSSLP+1
PHPASS ;
S PSSLP=0 S PSSPHEN="" F S PSSPHEN=$O(PSSGIARR(PSSPHEN)) Q:PSSPHEN=""!(PSSPGXQT) S PSSLP=PSSLP+1 W !,$S(PSSLP>99:"",PSSLP>9:" ",1:" "),PSSLP_") ",PSSPHEN D PAUSE4
I 'PSSLP W !!,"There are no selectable phenotypes for "_PSSGLPH,! D PAUSE2 Q ""
PHPASS1 ;
W ! K DIR S DIR("?")=" "
S DIR("?",1)="Enter the Phenotype by selecting one and only one entry from the list.",DIR("?",2)="This response is optional."
S DIR(0)="LO^1:"_PSSLP_":" W ! S DIR("A")="Select "_PSSGLPH_" Phenotype" D ^DIR
I Y'>0!($D(DIRUT)) Q ""
S PSSZZ=0 F PSSZ=1:1:$L(Y) I $E(Y,PSSZ)="," S PSSZZ=PSSZZ+1
I PSSZZ>1 W !!,"Only one Phenotype selection allowed." G PHPASS1
S PSSCX=+Y S PSSPTYPE=$G(PSSGISEL(PSSCX)) W " "_PSSPTYPE,!
Q PSSPTYPE
;
PAUSE ;
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to see PGx Findings, '^' to exit" D ^DIR K DIR I 'Y S PSSPGXQT=1
Q
;
PAUSE2 ;
W ! K DIR S DIR(0)="E",DIR("A")=" Press Return to continue" D ^DIR K DIR W !
Q
;
PAUSE3 ;
I ($Y+5)'>IOSL Q
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
W @IOF
Q
;
PAUSE4 ;
I ($Y+5)'>IOSL Q
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSPGXQT=1
W @IOF
Q
;
PAUSE5 ;
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSPGXQT=1
W @IOF
Q
;
SETPGX ;
;Set displayable TMP global from PSSPHAR array
N PSSXL,PSSXCT,PSSACT,PSSTEMPX,PSSSUB2,PSSQLRF,PSSGNW,PSSCREEN,PSSSUB1
S PSSSUB1="" F S PSSSUB1=$O(PSSPHAR(PSSSUB1)) Q:PSSSUB1="" D
.S PSSXL="" F S PSSXL=$O(PSSPHAR(PSSSUB1,PSSXL)) Q:PSSXL="" S PSSXCT=1 D
..S PSSCREEN=$S($G(PSSPHAR(PSSSUB1,PSSXL,"ACTION LONG"))=""&($G(PSSPHAR(PSSSUB1,PSSXL,"MONITORING LONG"))="")&($G(PSSPHAR(PSSSUB1,PSSXL,"RATIONALE LONG"))=""):1,1:0)
..S PSSACT=$S($G(PSSPHAR(PSSSUB1,PSSXL,"DISPLAY ACTION"))="Informational":"MEDIUM",$G(PSSPHAR(PSSSUB1,PSSXL,"DISPLAY ACTION"))="Interruptive":"HIGH",1:"NONE")
..S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="Pharmacogenomic "_$S(PSSACT="NONE":"Order Check:",1:PSSACT_" Order Check:") D INC
..S PSSGNW=$S('PSSCREEN:$G(PSSPHAR(PSSSUB1,PSSXL,"DXID")),1:$$TGENE) D
...I $L(PSSGNW)<56 S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" GENOMIC FINDING: "_PSSGNW D INC Q
...S PSSTEMPX=PSSGNW S PSSQLRF=1 D FORMAT(PSSTEMPX) K PSSQLRF
..S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" IMPACTED MEDICATION: "_$G(PSSPHAR(PSSSUB1,PSSXL,"DRUG")) D INC
..S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="" D INC
..I 'PSSCREEN S PSSTEMPX="ACTION: "_$G(PSSPHAR(PSSSUB1,PSSXL,"ACTION LONG")) D FORMAT(PSSTEMPX)
..I 'PSSCREEN S PSSTEMPX="RATIONALE: "_$G(PSSPHAR(PSSSUB1,PSSXL,"RATIONALE LONG")) D FORMAT(PSSTEMPX)
..I 'PSSCREEN S PSSTEMPX="MONITORING: "_$G(PSSPHAR(PSSSUB1,PSSXL,"MONITORING LONG")) D FORMAT(PSSTEMPX)
..I PSSCREEN S PSSTEMPX="Reason(s): "_$G(PSSPHAR(PSSSUB1,PSSXL,"SCREEN")) D FORMAT(PSSTEMPX)
..S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="For more details on VA National Pharmacogenomics Program go to:" D INC
..S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$P($G(^PS(59.7,1,"PGX")),"^") D INC
..S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="" D INC
..I 'PSSCREEN D ADDINFO^PSSPGXPR
Q
;
TGENE() ;
N PSSTVAL1,PSSTVAL2,PSSTVAL3,PSSTVAL4,PSSTVAL5
S PSSTVAL5=""
S PSSTVAL4=0 F PSSTVAL1=1:1 Q:'$D(PSSPHAR(PSSSUB1,PSSXL,"GENE",PSSTVAL1)) D
.S PSSTVAL2=$G(PSSPHAR(PSSSUB1,PSSXL,"GENE",PSSTVAL1,"GENE")) Q:PSSTVAL2=""!($D(PSSTVAL3(PSSTVAL2)))
.S PSSTVAL5=$S('PSSTVAL4:PSSTVAL2,1:PSSTVAL5_", "_PSSTVAL2) S PSSTVAL4=1,PSSTVAL3(PSSTVAL2)=""
Q PSSTVAL5
;
INC ;
S PSSXCT=PSSXCT+1
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
I $G(PSSQLRF) S PSSQLC=1 D
.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)=$S(PSSQLC=1:" GENOMIC FINDING: ",1:" ")_$G(^UTILITY($J,"W",PSSW1,PSSW2,0)) S PSSQLC=PSSQLC+1 D INC
I '$G(PSSQLRF) 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
K ^UTILITY($J,"W"),PSSTEMPX
I '$G(PSSQLRF) S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="" D INC
Q
;
DISP ;Display results
N PSSDX,PSSDXC,PSSDXCT,PSSSVT,PSSDS1
W @IOF
S PSSDXCT=0
I '$D(^TMP($J,"PSSXWARN")) W !?5,"No PGx Order Checks to display.",!! D PAUSE2 Q
S PSSDS1="" F S PSSDS1=$O(^TMP($J,"PSSXWARN",PSSDS1)) Q:PSSDS1=""!(PSSPGXQT) D
.S PSSDX="" F S PSSDX=$O(^TMP($J,"PSSXWARN",PSSDS1,PSSDX)) Q:PSSDX=""!(PSSPGXQT) D
..I PSSDXCT D PAUSE5 Q:PSSPGXQT
..S PSSDXC="" F S PSSDXC=$O(^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)) Q:PSSDXC=""!(PSSDXC="AI")!(PSSPGXQT) S:PSSDS1'="ERROR" PSSDXCT=1 D
...W !,^TMP($J,"PSSXWARN",PSSDS1,PSSDX,PSSDXC) I ($Y+5)>IOSL D PAUSE5
..I '$D(^TMP($J,"PSSXWARN",PSSDS1,PSSDX,"AI")) D PAUSE5 Q
..I '$$ASKAI W ! Q
..K IOP,%ZIS,POP S %ZIS="QM" W ! D ^%ZIS I $G(POP)>0 W !,"Nothing queued to print.",! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,IOP,%ZIS,POP Q
..I $D(IO("Q")) D Q
...S ZTRTN="PRTAI^PSSPGXTS",ZTDESC="Pharmacogenomic Additional Information"
...S ZTSAVE("PSSPGXQT")="",ZTSAVE("PSSDS1")="",ZTSAVE("PSSDX")="",ZTSAVE("^TMP($J,""PSSXWARN"",PSSDS1,PSSDX,""AI"",")=""
...D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",!
...K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
..D PRTAI
;D RDAT
Q
;
PRTAI ;Print Additional Informational
U IO
W @IOF
N PSSDS2
S PSSDS2="" F S PSSDS2=$O(^TMP($J,"PSSXWARN",PSSDS1,PSSDX,"AI",PSSDS2)) Q:PSSDS2=""!(PSSPGXQT) D
.I ($Y+5)>IOSL D
..I $E(IOST,1,2)="C-" D PAUSE5 W:PSSPGXQT ! Q
..W @IOF
.W !,^TMP($J,"PSSXWARN",PSSDS1,PSSDX,"AI",PSSDS2)
I $E(IOST,1,2)="C-" D PAUSE5
I $E(IOST,1,2)'="C-" W @IOF
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
ASKAI() ;display additional information prompt
NEW DIR,X,Y
S DIR(0)="Y",DIR("A")="Display Additional Information on Pharmacogenomic Order Check(s)",DIR("B")="NO"
S DIR("?")="Enter 'YES' if you want to display the additional information for the Pharmacogenomic Order Check"
D ^DIR
I 'Y W ! Q 0
Q 1
;
RDAT ;
;N DIR,X,Y,DTOUT,DUOUT,DIRUT
;K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to see the raw data output" D ^DIR I Y=1 W !! ZW ^TMP("PSSPGXBS",$J) W !! Q
;W !
Q
;
PAUSEL ;
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit list" D ^DIR K DIR I 'Y S PSSPGXQL=1 Q
W @IOF
Q
BADGCN ;Test option only - BAD GCNSEQ
S PSSERRG7=1
S PSSERRG1="" F S PSSERRG1=$O(^TMP("PSSPGXBS",$J,PSSERRG1)) Q:PSSERRG1="" D
.S PSSERRG2="" F S PSSERRG2=$O(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG2)) Q:PSSERRG2="" D
..S PSSERRG3="" F S PSSERRG3=$O(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG2,"C",PSSERRG3)) Q:PSSERRG3="" D
...I $G(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG2,"C",PSSERRG3))="drugCheck" D
....Q:$G(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG3))'="drugCheck"
....S PSSERRG4="" F S PSSERRG4=$O(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG3,"C",PSSERRG4)) Q:PSSERRG4="" D
.....I ^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG3,"C",PSSERRG4)="drugsNotChecked" D
......Q:$G(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG4))'="drugsNotChecked"
......S PSSERRG5="" F S PSSERRG5=$O(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG4,"C",PSSERRG5)) Q:PSSERRG5="" D
.......I ^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG4,"C",PSSERRG5)="drugNotChecked" D
........Q:$G(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG5))'="drugNotChecked"
........S PSSERRG6="" F S PSSERRG6=$O(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG5,"C",PSSERRG6)) Q:PSSERRG6="" D
.........I ^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG6)="drug" D
..........S PSSERRGN=$G(^TMP("PSSPGXBS",$J,PSSERRG1,PSSERRG6,"A","drugName"))
..........S PSSERRGN=$S($G(PSSERRGN)="":"Unknown Drug",1:PSSERRGN)
..........S PSSERRGL=$L(PSSERRGN)
..........S ^TMP($J,"PSSXWARN","ERROR",PSSERRG7,1)=$G(PSSERRGN)_" has a bad GCNSEQ number and could not"
..........S ^TMP($J,"PSSXWARN","ERROR",PSSERRG7,2)="be screened for Pharmacogenomic Order Checks."
..........S PSSERRG7=PSSERRG7+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPGXTS 15458 printed Mar 25, 2026@15:58:16 Page 2
PSSPGXTS ;BIR/RTR - PHARMACOGENOMICS TEST OPTION ;09/20/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
+2 ;
EN ;
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DLAYGO,PSSLTXT,PSSGENE,PSSVAR1,PSSVAR2,PSSGCT,PSSPGXRS,PSSPGXDC,PSSLOC,PSSLOCNM,PSSVAR4,PSSDRGCT,PSSERRG1,PSSERRG2,PSSERRG3,PSSERRG4,PSSERRG5,PSSERRG6,PSSERRG7,PSSERRGN,PSSERRGL
+2 NEW PSSPGXQT,PSSPGXDG,PSSPGXND,PSSPPROD,PSSDF1C,PSSGAR,PSSGLP,PSS50IEN,PSSDISPD,PSSDISPG,PSSPGXSV,PSSPGXAR,PSSPHAR,PSSPGXVA,PSSGLPH,PSSFDBFG,PSSOPTFG,PSSGTYPE,PSSLFEED,PSSGLOOP,PSSGVAL,PSSGVALT,PSSPHEN,PSSSCORE,PSSPGEND
+3 NEW PSSPDRUG,PSSASKQT,PSSTESTP,PSSGENES,PSSPERR,PSSNOADD,PSSLOCZZ,PSSPHDT
+4 WRITE @IOF,!!," PHARMACOGENOMIC (PGx) TEST OPTION",!
EN3 ;restart after exit from Patient prompt
+1 SET (PSSASKQT,PSSTESTP,PSSPDRUG,PSSGLOOP)=0
+2 SET PSSPGEND=$$ASK^PSSPGXT1()
+3 IF PSSASKQT
WRITE !
QUIT
+4 IF 'PSSPGEND
GOTO EN1
EN4 ;restart after exit from any prompt past patient prompt
+1 WRITE !
DO ASKPT^PSSPGXT1
IF 'PSSTESTP
WRITE !!
KILL PSSPGEND
GOTO EN3
+2 DO DISP^PSSPGXT1
IF PSSASKQT
DO RESET^PSSPGXT1
GOTO EN4
+3 DO ASKDR^PSSPGXT1
IF PSSASKQT
DO RESET^PSSPGXT1
GOTO EN4
+4 ;
EN1 ;
+1 IF $GET(PSSDRGCT)
WRITE @IOF
+2 SET (PSSDF1C,PSSPGXQT,PSSGCT,PSSDRGCT,PSSLFEED)=0
+3 KILL PSSGAR,PSSGENE,PSSPGXAR
+4 IF '$GET(PSSPGEND)
KILL PSSPGXDG,PSSPGXVA,PSSLOCNM
+5 KILL ^TMP("PSSPGXBS",$JOB),^TMP("PSSXWARN",$JOB)
+6 IF '$GET(PSSNOADD)
DO DRUG
+7 IF '$DATA(PSSPGXDG)
IF $GET(PSSPGEND)
DO RESET^PSSPGXT1
GOTO EN4
+8 IF '$DATA(PSSPGXDG)
WRITE !
KILL PSSPHDT
QUIT
+9 IF PSSPGEND
IF $DATA(PSSGENES)
DO CONV^PSSPGXT1
GOTO EN2
+10 DO GENE
+11 WRITE !
SET PSSGLP=""
FOR
SET PSSGLP=$ORDER(PSSGAR(PSSGLP))
if PSSGLP=""!(PSSPGXQT)
QUIT
Begin DoDot:1
+12 SET PSSGCT=PSSGCT+1
+13 SET PSSGENE(PSSGLP,"GENE")=""
+14 SET PSSGENE(PSSGLP,"GENOTYPE")=$$GENOTP()
+15 SET PSSGENE(PSSGLP,"ACTIVITY_SCORE")=$$ACTSCR^PSSPGXT1()
+16 SET PSSGENE(PSSGLP,"PHENOTYPE")=$$PHENOTP(PSSGLP)
+17 WRITE !!,?3,"Gene: "_PSSGLP,!,?3,"Genotype: "_$GET(PSSGENE(PSSGLP,"GENOTYPE")),!,?3,"Activity Score: "_$GET(PSSGENE(PSSGLP,"ACTIVITY_SCORE")),!,?3,"Phenotype: "_$GET(PSSGENE(PSSGLP,"PHENOTYPE"))
+18 KILL DIR
WRITE !
SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="Y"
+19 SET DIR("?",1)="Enter 'Y' for Yes, 'N' for No, '^' to exit entire gene selection list."
DO ^DIR
SET PSSLFEED=1
+20 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
SET PSSPGXQT=1
QUIT
+21 IF Y
SET PSSPGXSV=PSSGLP
QUIT
+22 KILL PSSGENE(PSSGLP)
SET PSSGLP=$SELECT(PSSGCT=1:"",1:PSSPGXSV)
IF PSSGCT=1
SET PSSGCT=0
End DoDot:1
EN2 ;
+1 KILL PSSGENES
+2 IF PSSPGXQT
IF $GET(PSSPGEND)
DO RESET^PSSPGXT1
GOTO EN4
+3 IF PSSPGXQT
WRITE !
GOTO EN1
+4 SET PSSVAR1="PSSPGXBS"
SET PSSVAR4="PSSPGXOT"
+5 DO PGXOPT^PSSPGX(.PSSVAR1,.PSSPGXDG,.PSSGENE,.PSSVAR4)
IF +$GET(PSSFDBFG)
DO ERR^PSSPGXUT
+6 WRITE @IOF
+7 WRITE !!,"Inputs:"
+8 DO PAUSE4
FOR PSSDISPD=0:0
SET PSSDISPD=$ORDER(PSSPGXDG(PSSDISPD))
if 'PSSDISPD!(PSSPGXQT)
QUIT
Begin DoDot:1
+9 WRITE !!,"Drug: "_$GET(PSSPGXDG(PSSDISPD,"DRUGNAME"))
DO PAUSE4
if PSSPGXQT
QUIT
+10 WRITE !,"VA Product: "_$GET(PSSPGXVA(PSSDISPD,"VAPROD"))
DO PAUSE4
if PSSPGXQT
QUIT
+11 WRITE !,"GCNSEQNO: "_$GET(PSSPGXDG(PSSDISPD,"GCN"))
DO PAUSE4
if PSSPGXQT
QUIT
End DoDot:1
+12 DO PAUSE4
SET PSSDISPG=""
FOR
SET PSSDISPG=$ORDER(PSSGENE(PSSDISPG))
if PSSDISPG=""!(PSSPGXQT)
QUIT
Begin DoDot:1
+13 WRITE !!,"Gene: "_PSSDISPG
DO PAUSE4
if PSSPGXQT
QUIT
+14 WRITE !,"Genotype: "_$GET(PSSGENE(PSSDISPG,"GENOTYPE"))
DO PAUSE4
if PSSPGXQT
QUIT
+15 WRITE !,"Activity Score: "_$GET(PSSGENE(PSSDISPG,"ACTIVITY_SCORE"))
DO PAUSE4
if PSSPGXQT
QUIT
+16 WRITE !,"Phenotype: "_$GET(PSSGENE(PSSDISPG,"PHENOTYPE"))
DO PAUSE4
if PSSPGXQT
QUIT
End DoDot:1
+17 DO PAUSE
IF PSSPGXQT
WRITE !
if PSSPGEND
QUIT
WRITE !
GOTO EN1
+18 DO GETD^PSSPGXPR
DO BADGCN
DO SETPGX
DO DISP
KILL PSSPHAR
DO PAUSE3
+19 KILL ^TMP("PSSPGXBS",$JOB),^TMP($JOB,"PSSXWARN")
+20 IF PSSPGEND
DO RESET^PSSPGXT1
GOTO EN4
+21 DO RESET^PSSPGXT1
SET PSSPGEND=0
GOTO EN1
+22 ;
DRUG ;Drug selection
+1 NEW PSSVAPGX,PSSPGXLG,PSSPRMD,PSSSELGC
+2 if '$GET(PSSDRGCT)
DO INTRO^PSSPGXT1
SET PSSDRGCT=1
+3 KILL DIC
SET DIC(0)="AEMQZ"
SET DIC="^PSDRUG("
SET DIC("A")=$SELECT('PSSDF1C:"Select DRUG: ",1:"Select Another DRUG: ")
SET DIC("S")="I $P(^(0),""^"",3)'[""S""&($E($P(^(0),""^"",2),1,2)'=""XA"")"
DO ^DIC
IF Y<0
if $DATA(PSSLOCNM)
Begin DoDot:1
+4 WRITE !!?3,"Drugs Selected:"
DO AL^PSSPGXT1
SET PSSPRMD=""
FOR
SET PSSPRMD=$ORDER(PSSLOCZZ(PSSPRMD))
if PSSPRMD=""
QUIT
WRITE !?4,PSSPRMD
+5 DO PAUSE2
End DoDot:1
KILL PSSLOCZZ
QUIT
+6 SET PSS50IEN=+Y
+7 SET PSSPGXND=$GET(^PSDRUG(PSS50IEN,"ND"))
SET PSSLOC=$PIECE($GET(^PSDRUG(PSS50IEN,0)),"^")
+8 IF '$PIECE(PSSPGXND,"^")!('$PIECE(PSSPGXND,"^",3))
Begin DoDot:1
+9 WRITE !!,"Drug is not matched to the National Drug File."
End DoDot:1
DO PAUSE2
GOTO DRUG
+10 SET PSSPPROD=$$PROD0^PSNAPIS($PIECE(PSSPGXND,"^"),$PIECE(PSSPGXND,"^",3))
+11 IF $PIECE(PSSPPROD,"^",7)=""
Begin DoDot:1
+12 WRITE !!,"Drug does not have a GCNSEQNO."
End DoDot:1
DO PAUSE2
GOTO DRUG
+13 SET PSSSELGC=+$PIECE(PSSPPROD,"^",7)
+14 SET PSSVAPGX=$$PGX^PSNAPIS($PIECE(PSSPGXND,"^"),$PIECE(PSSPGXND,"^",3))
+15 IF '$GET(PSSVAPGX)
Begin DoDot:1
+16 SET PSSPGXLG=$LENGTH(PSSLOC)
+17 IF PSSPGXLG<27
WRITE !!,PSSLOC_" does not participate in Pharmacogenomic Order Checks."
QUIT
+18 WRITE !!,PSSLOC_" does not participate in",!,"Pharmacogenomic Order Checks."
End DoDot:1
DO PAUSE2
GOTO DRUG
+19 SET PSSDF1C=1
+20 WRITE !!?2,"VA PRODUCT: ",$PIECE(PSSPPROD,"^"),!?2," GCNSEQNO: ",PSSSELGC,!
+21 SET PSSPGXDG(PSSSELGC,"GCN")=PSSSELGC
+22 SET PSSPGXVA(PSSSELGC,"VAPROD")=$PIECE(PSSPPROD,"^")
+23 SET PSSPGXDG(PSSSELGC,"DRUGNAME")=$GET(PSSLOC)
+24 SET PSSPGXDG(PSSSELGC,"VUID")=$$GETVUID^XTID(50.68,,$PIECE(PSSPGXND,"^",3)_",")
+25 SET PSSLOCNM(PSSSELGC,"LOCNAME",PSSLOC)=""
+26 GOTO DRUG
+27 QUIT
+28 ;
GENE ;Gene selection
+1 NEW DIC,X,X,DINUM,DLAYGO,DUOUT,DTOUT,PSSPRM,PSSPRML
+2 KILL PSSGAR
+3 SET PSSPRM=0
GENES ;
+1 WRITE !
SET DIC=51.26
SET DIC(0)="QEAMZ"
SET DIC("A")=$SELECT(PSSPRM:"Select Another Gene: ",1:"Select Gene: ")
DO ^DIC
IF Y<0!($DATA(DUOUT))!($DATA(DTOUT))
Begin DoDot:1
+2 IF '$DATA(PSSGAR)
WRITE !!?3,"No Genes selected."
QUIT
+3 WRITE !!?3,"Genes Selected:"
SET PSSPRML=""
FOR
SET PSSPRML=$ORDER(PSSGAR(PSSPRML))
if PSSPRML=""
QUIT
WRITE !?4,PSSPRML
End DoDot:1
if $DATA(PSSGAR)
DO PAUSE2
QUIT
+4 IF $DATA(PSSGAR($PIECE(Y(0),"^")))
WRITE !!?5,"Gene was previously selected."
GOTO GENES
+5 SET PSSGAR($PIECE(Y(0),"^"))=""
SET PSSPRM=1
+6 GOTO GENES
+7 QUIT
+8 ;
GENOTP() ;Genotype selection
+1 NEW PSSGVCT
+2 KILL DIR
SET PSSGTYPE=""
+3 IF 'PSSGLOOP
FOR PSSGVCT=1:1
if PSSGVCT>11
QUIT
SET PSSGVALT=$TEXT(GDATA+PSSGVCT)
SET PSSGVAL($PIECE(PSSGVALT,";;",2))=$PIECE(PSSGVALT,";;",3)_";;"_$PIECE(PSSGVALT,";;",4)
+4 SET PSSGLOOP=1
+5 IF PSSLFEED
WRITE !!
+6 IF $DATA(PSSGVAL(PSSGLP))
WRITE !,"Examples: "_$PIECE(PSSGVAL(PSSGLP),";;")_", or "_$PIECE(PSSGVAL(PSSGLP),";;",2)_", etc.",!
+7 SET DIR("?")=" "
SET DIR("?",1)="Genotype is optional, leave blank if unknown. Answer must be 1-50 characters"
SET DIR("?",2)="in length."
+8 SET DIR(0)="FO^1:50"
SET DIR("A")="Genotype selection for "_PSSGLP_" (optional)"
DO ^DIR
+9 IF X=""!($DATA(DIRUT))
QUIT ""
+10 SET PSSGTYPE=X
+11 QUIT PSSGTYPE
+12 ;
GDATA ;
+1 ;;ABCG2;;c.421C>A C/A;;c.421C>A C/C
+2 ;;CYP2C;;G.96405502G>A A/A;;G.96405502G>A G/G
+3 ;;CYP2C19;;*1/*1;;*2/*17
+4 ;;CYP2C9;;*1/*1;;*1/*2
+5 ;;CYP2D6;;*2/*4;;*1/*10
+6 ;;CYP3A5;;*1/*4;;*1/*3
+7 ;;CYP4F2;;C.1297G>A G/G;;C.1297G>A A/A
+8 ;;SLCO1B1;;*15/*15;;*1A/*1A
+9 ;;TPMT;;*2/*3A;;*1/*8
+10 ;;VKORC1;;-1639G>A G/G;;1639G>A G/A
+11 ;;UGT1A1;;*28/*28;;*1/*1
+12 QUIT
+13 ;
PHENOTP(PSSGLPH) ;Phenotype selection
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,PSSLP,PSSZ,PSSZZ,PSSCX,PSSPTYPE,PSSLPTX
+2 NEW PSSGIEN,PSSGILP,PSSGIARR,PSSGISEL,PSSPGXQT,PSSGIPHN
+3 SET PSSPGXQT=0
+4 WRITE @IOF
+5 WRITE !!," Phenotype selection for "_PSSGLPH,!
+6 SET PSSGIEN=$ORDER(^PS(51.26,"B",PSSGLPH,0))
IF 'PSSGIEN
WRITE !!,"Unable to locate "_PSSGLPH_" to enable Phenotype selection.",!
DO PAUSE2
QUIT ""
+7 SET PSSGILP=""
FOR
SET PSSGILP=$ORDER(^PS(51.26,PSSGIEN,2,"B",PSSGILP))
if 'PSSGILP
QUIT
Begin DoDot:1
+8 SET PSSGIPHN=$PIECE($GET(^PS(51.28,PSSGILP,0)),"^")
IF PSSGIPHN'=""
SET PSSGIARR(PSSGIPHN)=""
End DoDot:1
+9 IF '$DATA(PSSGIARR)
WRITE !!,"There are no selectable phenotypes for "_PSSGLPH,!
DO PAUSE2
QUIT ""
+10 SET PSSLP=1
SET PSSLPTX=""
FOR
SET PSSLPTX=$ORDER(PSSGIARR(PSSLPTX))
if PSSLPTX=""
QUIT
Begin DoDot:1
+11 SET PSSGISEL(PSSLP)=PSSLPTX
SET PSSLP=PSSLP+1
End DoDot:1
PHPASS ;
+1 SET PSSLP=0
SET PSSPHEN=""
FOR
SET PSSPHEN=$ORDER(PSSGIARR(PSSPHEN))
if PSSPHEN=""!(PSSPGXQT)
QUIT
SET PSSLP=PSSLP+1
WRITE !,$SELECT(PSSLP>99:"",PSSLP>9:" ",1:" "),PSSLP_") ",PSSPHEN
DO PAUSE4
+2 IF 'PSSLP
WRITE !!,"There are no selectable phenotypes for "_PSSGLPH,!
DO PAUSE2
QUIT ""
PHPASS1 ;
+1 WRITE !
KILL DIR
SET DIR("?")=" "
+2 SET DIR("?",1)="Enter the Phenotype by selecting one and only one entry from the list."
SET DIR("?",2)="This response is optional."
+3 SET DIR(0)="LO^1:"_PSSLP_":"
WRITE !
SET DIR("A")="Select "_PSSGLPH_" Phenotype"
DO ^DIR
+4 IF Y'>0!($DATA(DIRUT))
QUIT ""
+5 SET PSSZZ=0
FOR PSSZ=1:1:$LENGTH(Y)
IF $EXTRACT(Y,PSSZ)=","
SET PSSZZ=PSSZZ+1
+6 IF PSSZZ>1
WRITE !!,"Only one Phenotype selection allowed."
GOTO PHPASS1
+7 SET PSSCX=+Y
SET PSSPTYPE=$GET(PSSGISEL(PSSCX))
WRITE " "_PSSPTYPE,!
+8 QUIT PSSPTYPE
+9 ;
PAUSE ;
+1 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to see PGx Findings, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSPGXQT=1
+2 QUIT
+3 ;
PAUSE2 ;
+1 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")=" Press Return to continue"
DO ^DIR
KILL DIR
WRITE !
+2 QUIT
+3 ;
PAUSE3 ;
+1 IF ($Y+5)'>IOSL
QUIT
+2 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+3 WRITE @IOF
+4 QUIT
+5 ;
PAUSE4 ;
+1 IF ($Y+5)'>IOSL
QUIT
+2 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSPGXQT=1
+3 WRITE @IOF
+4 QUIT
+5 ;
PAUSE5 ;
+1 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSPGXQT=1
+2 WRITE @IOF
+3 QUIT
+4 ;
SETPGX ;
+1 ;Set displayable TMP global from PSSPHAR array
+2 NEW PSSXL,PSSXCT,PSSACT,PSSTEMPX,PSSSUB2,PSSQLRF,PSSGNW,PSSCREEN,PSSSUB1
+3 SET PSSSUB1=""
FOR
SET PSSSUB1=$ORDER(PSSPHAR(PSSSUB1))
if PSSSUB1=""
QUIT
Begin DoDot:1
+4 SET PSSXL=""
FOR
SET PSSXL=$ORDER(PSSPHAR(PSSSUB1,PSSXL))
if PSSXL=""
QUIT
SET PSSXCT=1
Begin DoDot:2
+5 SET PSSCREEN=$SELECT($GET(PSSPHAR(PSSSUB1,PSSXL,"ACTION LONG"))=""&($GET(PSSPHAR(PSSSUB1,PSSXL,"MONITORING LONG"))="")&($GET(PSSPHAR(PSSSUB1,PSSXL,"RATIONALE LONG"))=""):1,1:0)
+6 SET PSSACT=$SELECT($GET(PSSPHAR(PSSSUB1,PSSXL,"DISPLAY ACTION"))="Informational":"MEDIUM",$GET(PSSPHAR(PSSSUB1,PSSXL,"DISPLAY ACTION"))="Interruptive":"HIGH",1:"NONE")
+7 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="Pharmacogenomic "_$SELECT(PSSACT="NONE":"Order Check:",1:PSSACT_" Order Check:")
DO INC
+8 SET PSSGNW=$SELECT('PSSCREEN:$GET(PSSPHAR(PSSSUB1,PSSXL,"DXID")),1:$$TGENE)
Begin DoDot:3
+9 IF $LENGTH(PSSGNW)<56
SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" GENOMIC FINDING: "_PSSGNW
DO INC
QUIT
+10 SET PSSTEMPX=PSSGNW
SET PSSQLRF=1
DO FORMAT(PSSTEMPX)
KILL PSSQLRF
End DoDot:3
+11 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=" IMPACTED MEDICATION: "_$GET(PSSPHAR(PSSSUB1,PSSXL,"DRUG"))
DO INC
+12 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
DO INC
+13 IF 'PSSCREEN
SET PSSTEMPX="ACTION: "_$GET(PSSPHAR(PSSSUB1,PSSXL,"ACTION LONG"))
DO FORMAT(PSSTEMPX)
+14 IF 'PSSCREEN
SET PSSTEMPX="RATIONALE: "_$GET(PSSPHAR(PSSSUB1,PSSXL,"RATIONALE LONG"))
DO FORMAT(PSSTEMPX)
+15 IF 'PSSCREEN
SET PSSTEMPX="MONITORING: "_$GET(PSSPHAR(PSSSUB1,PSSXL,"MONITORING LONG"))
DO FORMAT(PSSTEMPX)
+16 IF PSSCREEN
SET PSSTEMPX="Reason(s): "_$GET(PSSPHAR(PSSSUB1,PSSXL,"SCREEN"))
DO FORMAT(PSSTEMPX)
+17 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)="For more details on VA National Pharmacogenomics Program go to:"
DO INC
+18 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$PIECE($GET(^PS(59.7,1,"PGX")),"^")
DO INC
+19 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
DO INC
+20 IF 'PSSCREEN
DO ADDINFO^PSSPGXPR
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
TGENE() ;
+1 NEW PSSTVAL1,PSSTVAL2,PSSTVAL3,PSSTVAL4,PSSTVAL5
+2 SET PSSTVAL5=""
+3 SET PSSTVAL4=0
FOR PSSTVAL1=1:1
if '$DATA(PSSPHAR(PSSSUB1,PSSXL,"GENE",PSSTVAL1))
QUIT
Begin DoDot:1
+4 SET PSSTVAL2=$GET(PSSPHAR(PSSSUB1,PSSXL,"GENE",PSSTVAL1,"GENE"))
if PSSTVAL2=""!($DATA(PSSTVAL3(PSSTVAL2)))
QUIT
+5 SET PSSTVAL5=$SELECT('PSSTVAL4:PSSTVAL2,1:PSSTVAL5_", "_PSSTVAL2)
SET PSSTVAL4=1
SET PSSTVAL3(PSSTVAL2)=""
End DoDot:1
+6 QUIT PSSTVAL5
+7 ;
INC ;
+1 SET PSSXCT=PSSXCT+1
+2 QUIT
+3 ;
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 IF $GET(PSSQLRF)
SET PSSQLC=1
Begin DoDot:1
+6 SET PSSW1=""
FOR
SET PSSW1=$ORDER(^UTILITY($JOB,"W",PSSW1))
if PSSW1=""
QUIT
Begin DoDot:2
+7 SET PSSW2=""
FOR
SET PSSW2=$ORDER(^UTILITY($JOB,"W",PSSW1,PSSW2))
if PSSW2=""
QUIT
Begin DoDot:3
+8 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$SELECT(PSSQLC=1:" GENOMIC FINDING: ",1:" ")_$GET(^UTILITY($JOB,"W",PSSW1,PSSW2,0))
SET PSSQLC=PSSQLC+1
DO INC
End DoDot:3
End DoDot:2
End DoDot:1
+9 IF '$GET(PSSQLRF)
SET PSSW1=""
FOR
SET PSSW1=$ORDER(^UTILITY($JOB,"W",PSSW1))
if PSSW1=""
QUIT
Begin DoDot:1
+10 SET PSSW2=""
FOR
SET PSSW2=$ORDER(^UTILITY($JOB,"W",PSSW1,PSSW2))
if PSSW2=""
QUIT
Begin DoDot:2
+11 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=$GET(^UTILITY($JOB,"W",PSSW1,PSSW2,0))
DO INC
End DoDot:2
End DoDot:1
+12 KILL ^UTILITY($JOB,"W"),PSSTEMPX
+13 IF '$GET(PSSQLRF)
SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,PSSXCT)=""
DO INC
+14 QUIT
+15 ;
DISP ;Display results
+1 NEW PSSDX,PSSDXC,PSSDXCT,PSSSVT,PSSDS1
+2 WRITE @IOF
+3 SET PSSDXCT=0
+4 IF '$DATA(^TMP($JOB,"PSSXWARN"))
WRITE !?5,"No PGx Order Checks to display.",!!
DO PAUSE2
QUIT
+5 SET PSSDS1=""
FOR
SET PSSDS1=$ORDER(^TMP($JOB,"PSSXWARN",PSSDS1))
if PSSDS1=""!(PSSPGXQT)
QUIT
Begin DoDot:1
+6 SET PSSDX=""
FOR
SET PSSDX=$ORDER(^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX))
if PSSDX=""!(PSSPGXQT)
QUIT
Begin DoDot:2
+7 IF PSSDXCT
DO PAUSE5
if PSSPGXQT
QUIT
+8 SET PSSDXC=""
FOR
SET PSSDXC=$ORDER(^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC))
if PSSDXC=""!(PSSDXC="AI")!(PSSPGXQT)
QUIT
if PSSDS1'="ERROR"
SET PSSDXCT=1
Begin DoDot:3
+9 WRITE !,^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,PSSDXC)
IF ($Y+5)>IOSL
DO PAUSE5
End DoDot:3
+10 IF '$DATA(^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,"AI"))
DO PAUSE5
QUIT
+11 IF '$$ASKAI
WRITE !
QUIT
+12 KILL IOP,%ZIS,POP
SET %ZIS="QM"
WRITE !
DO ^%ZIS
IF $GET(POP)>0
WRITE !,"Nothing queued to print.",!
KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,IOP,%ZIS,POP
QUIT
+13 IF $DATA(IO("Q"))
Begin DoDot:3
+14 SET ZTRTN="PRTAI^PSSPGXTS"
SET ZTDESC="Pharmacogenomic Additional Information"
+15 SET ZTSAVE("PSSPGXQT")=""
SET ZTSAVE("PSSDS1")=""
SET ZTSAVE("PSSDX")=""
SET ZTSAVE("^TMP($J,""PSSXWARN"",PSSDS1,PSSDX,""AI"",")=""
+16 DO ^%ZTLOAD
KILL %ZIS
WRITE !!,"Report queued to print.",!
+17 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:3
QUIT
+18 DO PRTAI
End DoDot:2
End DoDot:1
+19 ;D RDAT
+20 QUIT
+21 ;
PRTAI ;Print Additional Informational
+1 USE IO
+2 WRITE @IOF
+3 NEW PSSDS2
+4 SET PSSDS2=""
FOR
SET PSSDS2=$ORDER(^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,"AI",PSSDS2))
if PSSDS2=""!(PSSPGXQT)
QUIT
Begin DoDot:1
+5 IF ($Y+5)>IOSL
Begin DoDot:2
+6 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE5
if PSSPGXQT
WRITE !
QUIT
+7 WRITE @IOF
End DoDot:2
+8 WRITE !,^TMP($JOB,"PSSXWARN",PSSDS1,PSSDX,"AI",PSSDS2)
End DoDot:1
+9 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE5
+10 IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
+11 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+12 QUIT
ASKAI() ;display additional information prompt
+1 NEW DIR,X,Y
+2 SET DIR(0)="Y"
SET DIR("A")="Display Additional Information on Pharmacogenomic Order Check(s)"
SET DIR("B")="NO"
+3 SET DIR("?")="Enter 'YES' if you want to display the additional information for the Pharmacogenomic Order Check"
+4 DO ^DIR
+5 IF 'Y
WRITE !
QUIT 0
+6 QUIT 1
+7 ;
RDAT ;
+1 ;N DIR,X,Y,DTOUT,DUOUT,DIRUT
+2 ;K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to see the raw data output" D ^DIR I Y=1 W !! ZW ^TMP("PSSPGXBS",$J) W !! Q
+3 ;W !
+4 QUIT
+5 ;
PAUSEL ;
+1 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit list"
DO ^DIR
KILL DIR
IF 'Y
SET PSSPGXQL=1
QUIT
+2 WRITE @IOF
+3 QUIT
BADGCN ;Test option only - BAD GCNSEQ
+1 SET PSSERRG7=1
+2 SET PSSERRG1=""
FOR
SET PSSERRG1=$ORDER(^TMP("PSSPGXBS",$JOB,PSSERRG1))
if PSSERRG1=""
QUIT
Begin DoDot:1
+3 SET PSSERRG2=""
FOR
SET PSSERRG2=$ORDER(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG2))
if PSSERRG2=""
QUIT
Begin DoDot:2
+4 SET PSSERRG3=""
FOR
SET PSSERRG3=$ORDER(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG2,"C",PSSERRG3))
if PSSERRG3=""
QUIT
Begin DoDot:3
+5 IF $GET(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG2,"C",PSSERRG3))="drugCheck"
Begin DoDot:4
+6 if $GET(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG3))'="drugCheck"
QUIT
+7 SET PSSERRG4=""
FOR
SET PSSERRG4=$ORDER(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG3,"C",PSSERRG4))
if PSSERRG4=""
QUIT
Begin DoDot:5
+8 IF ^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG3,"C",PSSERRG4)="drugsNotChecked"
Begin DoDot:6
+9 if $GET(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG4))'="drugsNotChecked"
QUIT
+10 SET PSSERRG5=""
FOR
SET PSSERRG5=$ORDER(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG4,"C",PSSERRG5))
if PSSERRG5=""
QUIT
Begin DoDot:7
+11 IF ^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG4,"C",PSSERRG5)="drugNotChecked"
Begin DoDot:8
+12 if $GET(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG5))'="drugNotChecked"
QUIT
+13 SET PSSERRG6=""
FOR
SET PSSERRG6=$ORDER(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG5,"C",PSSERRG6))
if PSSERRG6=""
QUIT
Begin DoDot:9
+14 IF ^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG6)="drug"
Begin DoDot:10
+15 SET PSSERRGN=$GET(^TMP("PSSPGXBS",$JOB,PSSERRG1,PSSERRG6,"A","drugName"))
+16 SET PSSERRGN=$SELECT($GET(PSSERRGN)="":"Unknown Drug",1:PSSERRGN)
+17 SET PSSERRGL=$LENGTH(PSSERRGN)
+18 SET ^TMP($JOB,"PSSXWARN","ERROR",PSSERRG7,1)=$GET(PSSERRGN)_" has a bad GCNSEQ number and could not"
+19 SET ^TMP($JOB,"PSSXWARN","ERROR",PSSERRG7,2)="be screened for Pharmacogenomic Order Checks."
+20 SET PSSERRG7=PSSERRG7+1
End DoDot:10
End DoDot:9
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
