PSSPGX ;BIR/MV - PHARMACOGENOMICS API ;09/20/07
;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
;
; Reference to ^MXMLDOM is supported by DBIA #3561
;
PGXOPT(PSSBASE,PSSDRUGS,PSSGENES,PSSOUT) ;PHARMACOGENOMIC (PGx) TEST OPTION
;PSSBASE = Name of subscript(ex: PSSPGX) [require]
; PSSDRUGS(PSSIEN,"DRUGNAME")=Drug name [require] ;PSSIEN of file 50
; PSSDRUGS(PSSIEN,"GCN")=GCNSEQNO [require]
; PSSDRUGS(PSSIEN,"VUID")=VUID [require]
;PSSGENES = Genetic test array for PGX order checks.
; PSSGENES(GENE,"GENE")="" [require]
; PSSGENES(GENE,"GENOTYPE")=VINCI_Genotype - ex: PSSGENES(CYP2D6,"GENOTYPE")="*>*9/*10"
; PSSGENES(GENE,"PHENOTYPE")=VINCI_Phenotype - ex: PSSGENES(CYP2D6,"PHENOTYPE")="INTERMEDIATE/NORMAL/ULTRARAPID METABOLIZER"
; PSSGENES(GENE,"ACTIVITY_SCORE")=VINCI_ActivityScore - ex: PSSGENES(CYP2D6,"ACTIVITY_SCORE")="1-3"
;PSSOUT = 1 for successful; results are stored in ^TMP($J,"PSSPGX")
; -1^error message (ex: -1^ERROR #6059: Unable to open TCP/IP socket...
NEW PSSPGXDG,PSSNOGCN
K ^TMP($J,"OUT XML"),^TMP(PSSBASE,$J),^TMP($J,"PSSXWARN"),^TMP("PSSPGXBS",$J)
S PSSOPTFG=1 ;not building the ^TMP($J,"PSSXWARN")
D PGXMAIN^PSSPGX1(PSSBASE,.PSSGENES,.PSSDRUGS,.PSSOUT)
Q
;
PGXOC(PSSBASE,PSSDFN,PSSDRUGS,PSSOUT,PSSPGXPK) ;Pharmacogenomics findings for Inpatient, Outpatient, CPRS(?)
;PSSBASE = Name of subscript(ex: PSJPGX, PSOPGX, or ORPGX) [require]
;PSSDFN = Patient DFN
;PSSDRUGS(IEN)= Dispense drug array from file 50 [require]
;PSSOUT = 1 for successful; results are stored in ^TMP($J,"PSSPGX")
; -1^error message (ex: -1^ERROR #6059: Unable to open TCP/IP socket...
NEW PSSPGXDG,PSSNOGCN,PSSHDRFG,PSSFDBFG,PSSOUT,PSSGENES,PSSPTLAB,PSSGDT,PSSGTBL,PSSURL,PSSPERR
I (+$$CHKSTAT^PSSDSFDB()=-1),'+$G(PSSOPTFG) Q
S PSSDFN=+$G(PSSDFN)
I $G(PSSBASE)="" S PSSBASE="PSSPGX"
K ^TMP($J,"OUT XML"),^TMP(PSSBASE,$J),^TMP($J,"PSSXWARN"),^TMP("PSSPGXBS",$J)
;Defined the drugs list to send FDB (this list only include PGx eligible drugs).
D SETDRUG(.PSSDRUGS,.PSSPGXDG,.PSSNOGCN) ;PSSNOGCN(IEN)= Drug IEN without GCNSEQNO
I '$D(PSSPGXDG) Q
S PSSHDRFG=0
;Get patient PGx lab data from HDR (this call checks for Gene and phenotype that map to FDB, use HDR value if can't find match)
S PSSOUT=$$GETPGXRESULTS^PSSHDPG1(PSSDFN,.PSSPTLAB)
D PTLAB(.PSSPTLAB) ;Build genes list
S:+PSSOUT=-1 PSSHDRFG=1 ;PSSPGXPR checks PSSHDRFG to add HDR error message in the PGx display.
S PSSOUT=""
;Get FDB PGx result
D PGXMAIN^PSSPGX1(PSSBASE,.PSSGENES,.PSSPGXDG,.PSSOUT)
Q
;
SETDRUG(PSSDRUGS,PSSPGXDG,PSSNOGCN) ;Setup PSSPGXDG array of drug list to send to FDB
;Input PSSDRUGS - List of drug(s) from calling applications for PGx check
; PSSDRUGS(IEN)="" [require]
; PSSDRUGS(IEN,"DRUGNAME")=Drug name
; PSSDRUGS(IEN,"GCN")=GCNSEQNO
;Set PSSPGXDG - Only includes PGx eligibilty & have GCNseqno drugs (XML is build using these value0
; PSSPGXDG(IEN,"DRUGNAME")=Drug name
; PSSPGXDG(IEN,"GCN")=GCNSEQNO
; PSSPGXDG(IEN,"VUID")=VUID
;PSSNOGCN - array of drug without GCNSEQNO (ex. PSSNOGCN(IEN)="")
NEW PSSGCN,PSSIEN,PSSVAPRD,PSSVUID,PSSPGXOC
I '+$D(PSSDRUGS) Q
F PSSIEN=0:0 S PSSIEN=$O(PSSDRUGS(PSSIEN)) Q:'+PSSIEN D
. S (PSSVAPRD,PSSGCN,PSSVUID,PSSPGXOC)=""
. S PSSVAPRD=$P($G(^PSDRUG(+PSSIEN,"ND")),U,3)
. I +PSSVAPRD D
.. S PSSPGXOC=+$$PGX^PSNAPIS("",PSSVAPRD) ;1 is PGx eligible - 50.68)
.. S PSSGCN=+$P($G(^PSNDF(50.68,+PSSVAPRD,1)),U,5)
.. S PSSVUID=$P($G(^PSNDF(50.68,+PSSVAPRD,"VUID")),U)
. I '+$G(PSSGCN) S PSSNOGCN(PSSIEN)="" Q
. ;I +'PSSPGXOC!+PSSPGXOC D ;1 is PGx eligible. for now check for 0 or 1 since all return zero *********
. I +PSSPGXOC D
.. S PSSPGXDG(PSSIEN,"GCN")=PSSGCN
.. S PSSPGXDG(PSSIEN,"VUID")=$G(PSSVUID)
.. S PSSPGXDG(PSSIEN,"DRUGNAME")=$S($G(PSSDRUGS(PSSIEN,"DRUGNAME"))]"":PSSDRUGS(PSSIEN,"DRUGNAME"),1:$P($G(^PSDRUG(PSSIEN,0)),U,1))
Q
;
PTLAB(PSSPTLAB) ;Setup PSSGDT and PSSGENES arrays
;PSSPTLAB(GENE,CNT,"ACTIVITY_SCORE")
;PSSPTLAB(GENE,CNT,"GENOTYPE")
;PSSPTLAB(GENE,CNT,"NPP_SharePointURL")
;PSSPTLAB(GENE,CNT,"PHENOTYPE")
;PSSPTLAB(GENE,CNT,"RESULT_DATE")
Q:'$D(PSSPTLAB)
;PSSGDT(-RESULT_DATE,GENE,...where dates are in reverse)
D GENEDT(.PSSPTLAB)
;PSSGENES(GENE,...if dupl gene exists only include the gene with the latest date)
D GENELST(.PSSGDT)
Q
;
GENEDT(PSSPTLAB) ;Sort genes list by decending result_date
NEW PSSCNT,PSSGENE,PSSLABDT,PSSFMDT
Q:'$D(PSSPTLAB)
S PSSGENE="" F S PSSGENE=$O(PSSPTLAB(PSSGENE)) Q:PSSGENE="" D
. F PSSCNT=0:0 S PSSCNT=$O(PSSPTLAB(PSSGENE,PSSCNT)) Q:'PSSCNT D
.. S PSSLABDT=$G(PSSPTLAB(PSSGENE,PSSCNT,"RESULT_DATE"))
.. Q:PSSLABDT=""
.. S PSSFMDT=$$DTCNV(PSSLABDT)
.. S PSSGDT(-PSSFMDT,PSSGENE,"RESULT_DATE")=$$FMTE^XLFDT(PSSFMDT,"2S")
.. S PSSGDT(-PSSFMDT,PSSGENE,"GENOTYPE")=$G(PSSPTLAB(PSSGENE,PSSCNT,"GENOTYPE"))
.. S PSSGDT(-PSSFMDT,PSSGENE,"PHENOTYPE")=$G(PSSPTLAB(PSSGENE,PSSCNT,"PHENOTYPE"))
.. S PSSGDT(-PSSFMDT,PSSGENE,"ACTIVITY_SCORE")=$G(PSSPTLAB(PSSGENE,PSSCNT,"ACTIVITY_SCORE"))
.. S PSSGDT(-PSSFMDT,PSSGENE,"NPP_SharePointURL")=$G(PSSPTLAB(PSSGENE,PSSCNT,"NPP_SharePointURL"))
.. S PSSURL=PSSGDT(-PSSFMDT,PSSGENE,"NPP_SharePointURL")
Q
;
GENELST(PSSGDT) ;Sort by genes
;PSSGDT array - sorting with RESULT_DATE in reverse order. Ex: PSSGDT(-3170312,"CYP2C19","ACTIVITY_SCORE")=""
;PSSGENES array - Ex: PSSGENE(GENE,"GENE")
NEW PSSLABDT,PSSGENE
Q:'$D(PSSGDT)
S PSSLABDT="" F S PSSLABDT=$O(PSSGDT(PSSLABDT)) Q:PSSLABDT="" D
. S PSSGENE="" F S PSSGENE=$O(PSSGDT(PSSLABDT,PSSGENE)) Q:PSSGENE="" D
.. I $D(PSSGENES(PSSGENE,"GENE")) Q ;Only keep a gene from the latest result_date
.. S PSSGENES(PSSGENE,"GENE")=""
.. S PSSGENES(PSSGENE,"GENOTYPE")=$G(PSSGDT(PSSLABDT,PSSGENE,"GENOTYPE"))
.. S PSSGENES(PSSGENE,"PHENOTYPE")=$G(PSSGDT(PSSLABDT,PSSGENE,"PHENOTYPE"))
.. S PSSGENES(PSSGENE,"ACTIVITY_SCORE")=$G(PSSGDT(PSSLABDT,PSSGENE,"ACTIVITY_SCORE"))
.. S PSSGENES(PSSGENE,"RESULT_DATE")=$G(PSSGDT(PSSLABDT,PSSGENE,"RESULT_DATE"))
.. S PSSGENES(PSSGENE,"NPP_SharePointURL")=$G(PSSGDT(PSSLABDT,PSSGENE,"NPP_SharePointURL"))
Q
;
DTCNV(PSSEDT) ;Converse external date to Fileman internal date
;PSSEDT - External format (ex: 06/13/2024)
NEW PSSFMDT
Q:$G(PSSEDT)="" "ERROR"
S PSSFMDT=($P(PSSEDT,"/",3)-1700)_$P(PSSEDT,"/")_$P(PSSEDT,"/",2)
Q PSSFMDT
;
GENETBL(PSSGDT) ;
NEW PSSGENE,PSSCNT,PSSAS,PSSLABDT,PSSGENTP
Q:'$D(PSSGDT)
S PSSGTBL(1)="The patient has the following PGx labs:"
S PSSGTBL(2)=""
S PSSGTBL(3)=" Activity"
S PSSGTBL(4)="Lab Date Gene Score Phenotype"
S PSSCNT=4
S PSSLABDT="" F S PSSLABDT=$O(PSSGDT(PSSLABDT)) Q:PSSLABDT="" D
. S PSSGENE="" F S PSSGENE=$O(PSSGDT(PSSLABDT,PSSGENE)) Q:PSSGENE="" D
.. S PSSCNT=PSSCNT+1
.. ;Result date
.. S PSSTXT=$$FMTE^XLFDT($E(PSSLABDT,2,8),"5D")
.. S PSSTXT=PSSTXT_$$SPACES(PSSTXT,11)
.. S PSSGTBL(PSSCNT)=PSSTXT
.. ;Gene - truncate to 12 char.
.. S PSSTXT=$E(PSSGENE,1,12)_$$SPACES($E(PSSGENE,1,12),13)
.. S PSSGTBL(PSSCNT)=PSSGTBL(PSSCNT)_PSSTXT
.. ;Activity Score
.. S PSSAS=$G(PSSGDT(PSSLABDT,PSSGENE,"ACTIVITY_SCORE"))
.. S PSSTXT=PSSAS_$$SPACES(PSSAS,5)
.. S PSSGTBL(PSSCNT)=PSSGTBL(PSSCNT)_PSSTXT
.. ;Phenotype
.. S PSSTXT=$G(PSSGDT(PSSLABDT,PSSGENE,"PHENOTYPE"))
.. S PSSGENTP=$G(PSSGDT(PSSLABDT,PSSGENE,"GENOTYPE")) I PSSGENTP'="" S PSSTXT=PSSTXT_" (Genotype: "_PSSGENTP_")"
.. D PHENO(PSSTXT,1,49)
Q
;
PHENO(PSSTXT,DIWL,DIWR) ;format phenotype (can be longer than 50 chars)
NEW PSSX,PSSX1,PSSLINE,X
S X=$G(PSSTXT)
S:'+$G(PSSCNT) PSSCNT=1,PSSGTBL(PSSCNT)=""
I '$G(DIWL) S DIWL=1
I '$G(DIWR) S DIWR=75
K ^UTILITY($J,"W") D ^DIWP
;
S PSSX1=0
F PSSX=0:0 S PSSX=$O(^UTILITY($J,"W",1,PSSX)) Q:'PSSX D
. S PSSTXT=$G(^UTILITY($J,"W",1,PSSX,0)),PSSX1=PSSX1+1
. I PSSTXT]"" D
.. I $L(PSSTXT)>49 S PSSLINE(PSSX1)=$E(PSSTXT,1,49),PSSX1=PSSX1+1,PSSLINE(PSSX1)=$E(PSSTXT,49,$L(PSSTXT))
.. I $L(PSSTXT)<50 S PSSLINE(PSSX1)=PSSTXT
;
F PSSX1=0:0 S PSSX1=$O(PSSLINE(PSSX1)) Q:'PSSX1 D
. I PSSX1>1 S PSSCNT=PSSCNT+1,PSSGTBL(PSSCNT)=""
. S PSSGTBL(PSSCNT)=PSSGTBL(PSSCNT)_$$SPACES($G(PSSGTBL(PSSCNT)),29)_PSSLINE(PSSX1)
;
K ^UTILITY($J,"W"),DIWL,DIWR
Q
;
SPACES(PSSTXT,PSSCHR) ;Add trailing spaces
NEW PSSSPACE,PSSDIFF
Q:'+$G(PSSCHR) ""
S PSSDIFF=PSSCHR-$L($G(PSSTXT))
Q:+PSSDIFF<1 ""
S $P(PSSSPACE," ",PSSDIFF)=" "
Q PSSSPACE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPGX 8469 printed Mar 25, 2026@15:58:09 Page 2
PSSPGX ;BIR/MV - PHARMACOGENOMICS API ;09/20/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
+2 ;
+3 ; Reference to ^MXMLDOM is supported by DBIA #3561
+4 ;
PGXOPT(PSSBASE,PSSDRUGS,PSSGENES,PSSOUT) ;PHARMACOGENOMIC (PGx) TEST OPTION
+1 ;PSSBASE = Name of subscript(ex: PSSPGX) [require]
+2 ; PSSDRUGS(PSSIEN,"DRUGNAME")=Drug name [require] ;PSSIEN of file 50
+3 ; PSSDRUGS(PSSIEN,"GCN")=GCNSEQNO [require]
+4 ; PSSDRUGS(PSSIEN,"VUID")=VUID [require]
+5 ;PSSGENES = Genetic test array for PGX order checks.
+6 ; PSSGENES(GENE,"GENE")="" [require]
+7 ; PSSGENES(GENE,"GENOTYPE")=VINCI_Genotype - ex: PSSGENES(CYP2D6,"GENOTYPE")="*>*9/*10"
+8 ; PSSGENES(GENE,"PHENOTYPE")=VINCI_Phenotype - ex: PSSGENES(CYP2D6,"PHENOTYPE")="INTERMEDIATE/NORMAL/ULTRARAPID METABOLIZER"
+9 ; PSSGENES(GENE,"ACTIVITY_SCORE")=VINCI_ActivityScore - ex: PSSGENES(CYP2D6,"ACTIVITY_SCORE")="1-3"
+10 ;PSSOUT = 1 for successful; results are stored in ^TMP($J,"PSSPGX")
+11 ; -1^error message (ex: -1^ERROR #6059: Unable to open TCP/IP socket...
+12 NEW PSSPGXDG,PSSNOGCN
+13 KILL ^TMP($JOB,"OUT XML"),^TMP(PSSBASE,$JOB),^TMP($JOB,"PSSXWARN"),^TMP("PSSPGXBS",$JOB)
+14 ;not building the ^TMP($J,"PSSXWARN")
SET PSSOPTFG=1
+15 DO PGXMAIN^PSSPGX1(PSSBASE,.PSSGENES,.PSSDRUGS,.PSSOUT)
+16 QUIT
+17 ;
PGXOC(PSSBASE,PSSDFN,PSSDRUGS,PSSOUT,PSSPGXPK) ;Pharmacogenomics findings for Inpatient, Outpatient, CPRS(?)
+1 ;PSSBASE = Name of subscript(ex: PSJPGX, PSOPGX, or ORPGX) [require]
+2 ;PSSDFN = Patient DFN
+3 ;PSSDRUGS(IEN)= Dispense drug array from file 50 [require]
+4 ;PSSOUT = 1 for successful; results are stored in ^TMP($J,"PSSPGX")
+5 ; -1^error message (ex: -1^ERROR #6059: Unable to open TCP/IP socket...
+6 NEW PSSPGXDG,PSSNOGCN,PSSHDRFG,PSSFDBFG,PSSOUT,PSSGENES,PSSPTLAB,PSSGDT,PSSGTBL,PSSURL,PSSPERR
+7 IF (+$$CHKSTAT^PSSDSFDB()=-1)
IF '+$GET(PSSOPTFG)
QUIT
+8 SET PSSDFN=+$GET(PSSDFN)
+9 IF $GET(PSSBASE)=""
SET PSSBASE="PSSPGX"
+10 KILL ^TMP($JOB,"OUT XML"),^TMP(PSSBASE,$JOB),^TMP($JOB,"PSSXWARN"),^TMP("PSSPGXBS",$JOB)
+11 ;Defined the drugs list to send FDB (this list only include PGx eligible drugs).
+12 ;PSSNOGCN(IEN)= Drug IEN without GCNSEQNO
DO SETDRUG(.PSSDRUGS,.PSSPGXDG,.PSSNOGCN)
+13 IF '$DATA(PSSPGXDG)
QUIT
+14 SET PSSHDRFG=0
+15 ;Get patient PGx lab data from HDR (this call checks for Gene and phenotype that map to FDB, use HDR value if can't find match)
+16 SET PSSOUT=$$GETPGXRESULTS^PSSHDPG1(PSSDFN,.PSSPTLAB)
+17 ;Build genes list
DO PTLAB(.PSSPTLAB)
+18 ;PSSPGXPR checks PSSHDRFG to add HDR error message in the PGx display.
if +PSSOUT=-1
SET PSSHDRFG=1
+19 SET PSSOUT=""
+20 ;Get FDB PGx result
+21 DO PGXMAIN^PSSPGX1(PSSBASE,.PSSGENES,.PSSPGXDG,.PSSOUT)
+22 QUIT
+23 ;
SETDRUG(PSSDRUGS,PSSPGXDG,PSSNOGCN) ;Setup PSSPGXDG array of drug list to send to FDB
+1 ;Input PSSDRUGS - List of drug(s) from calling applications for PGx check
+2 ; PSSDRUGS(IEN)="" [require]
+3 ; PSSDRUGS(IEN,"DRUGNAME")=Drug name
+4 ; PSSDRUGS(IEN,"GCN")=GCNSEQNO
+5 ;Set PSSPGXDG - Only includes PGx eligibilty & have GCNseqno drugs (XML is build using these value0
+6 ; PSSPGXDG(IEN,"DRUGNAME")=Drug name
+7 ; PSSPGXDG(IEN,"GCN")=GCNSEQNO
+8 ; PSSPGXDG(IEN,"VUID")=VUID
+9 ;PSSNOGCN - array of drug without GCNSEQNO (ex. PSSNOGCN(IEN)="")
+10 NEW PSSGCN,PSSIEN,PSSVAPRD,PSSVUID,PSSPGXOC
+11 IF '+$DATA(PSSDRUGS)
QUIT
+12 FOR PSSIEN=0:0
SET PSSIEN=$ORDER(PSSDRUGS(PSSIEN))
if '+PSSIEN
QUIT
Begin DoDot:1
+13 SET (PSSVAPRD,PSSGCN,PSSVUID,PSSPGXOC)=""
+14 SET PSSVAPRD=$PIECE($GET(^PSDRUG(+PSSIEN,"ND")),U,3)
+15 IF +PSSVAPRD
Begin DoDot:2
+16 ;1 is PGx eligible - 50.68)
SET PSSPGXOC=+$$PGX^PSNAPIS("",PSSVAPRD)
+17 SET PSSGCN=+$PIECE($GET(^PSNDF(50.68,+PSSVAPRD,1)),U,5)
+18 SET PSSVUID=$PIECE($GET(^PSNDF(50.68,+PSSVAPRD,"VUID")),U)
End DoDot:2
+19 IF '+$GET(PSSGCN)
SET PSSNOGCN(PSSIEN)=""
QUIT
+20 ;I +'PSSPGXOC!+PSSPGXOC D ;1 is PGx eligible. for now check for 0 or 1 since all return zero *********
+21 IF +PSSPGXOC
Begin DoDot:2
+22 SET PSSPGXDG(PSSIEN,"GCN")=PSSGCN
+23 SET PSSPGXDG(PSSIEN,"VUID")=$GET(PSSVUID)
+24 SET PSSPGXDG(PSSIEN,"DRUGNAME")=$SELECT($GET(PSSDRUGS(PSSIEN,"DRUGNAME"))]"":PSSDRUGS(PSSIEN,"DRUGNAME"),1:$PIECE($GET(^PSDRUG(PSSIEN,0)),U,1))
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
PTLAB(PSSPTLAB) ;Setup PSSGDT and PSSGENES arrays
+1 ;PSSPTLAB(GENE,CNT,"ACTIVITY_SCORE")
+2 ;PSSPTLAB(GENE,CNT,"GENOTYPE")
+3 ;PSSPTLAB(GENE,CNT,"NPP_SharePointURL")
+4 ;PSSPTLAB(GENE,CNT,"PHENOTYPE")
+5 ;PSSPTLAB(GENE,CNT,"RESULT_DATE")
+6 if '$DATA(PSSPTLAB)
QUIT
+7 ;PSSGDT(-RESULT_DATE,GENE,...where dates are in reverse)
+8 DO GENEDT(.PSSPTLAB)
+9 ;PSSGENES(GENE,...if dupl gene exists only include the gene with the latest date)
+10 DO GENELST(.PSSGDT)
+11 QUIT
+12 ;
GENEDT(PSSPTLAB) ;Sort genes list by decending result_date
+1 NEW PSSCNT,PSSGENE,PSSLABDT,PSSFMDT
+2 if '$DATA(PSSPTLAB)
QUIT
+3 SET PSSGENE=""
FOR
SET PSSGENE=$ORDER(PSSPTLAB(PSSGENE))
if PSSGENE=""
QUIT
Begin DoDot:1
+4 FOR PSSCNT=0:0
SET PSSCNT=$ORDER(PSSPTLAB(PSSGENE,PSSCNT))
if 'PSSCNT
QUIT
Begin DoDot:2
+5 SET PSSLABDT=$GET(PSSPTLAB(PSSGENE,PSSCNT,"RESULT_DATE"))
+6 if PSSLABDT=""
QUIT
+7 SET PSSFMDT=$$DTCNV(PSSLABDT)
+8 SET PSSGDT(-PSSFMDT,PSSGENE,"RESULT_DATE")=$$FMTE^XLFDT(PSSFMDT,"2S")
+9 SET PSSGDT(-PSSFMDT,PSSGENE,"GENOTYPE")=$GET(PSSPTLAB(PSSGENE,PSSCNT,"GENOTYPE"))
+10 SET PSSGDT(-PSSFMDT,PSSGENE,"PHENOTYPE")=$GET(PSSPTLAB(PSSGENE,PSSCNT,"PHENOTYPE"))
+11 SET PSSGDT(-PSSFMDT,PSSGENE,"ACTIVITY_SCORE")=$GET(PSSPTLAB(PSSGENE,PSSCNT,"ACTIVITY_SCORE"))
+12 SET PSSGDT(-PSSFMDT,PSSGENE,"NPP_SharePointURL")=$GET(PSSPTLAB(PSSGENE,PSSCNT,"NPP_SharePointURL"))
+13 SET PSSURL=PSSGDT(-PSSFMDT,PSSGENE,"NPP_SharePointURL")
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
GENELST(PSSGDT) ;Sort by genes
+1 ;PSSGDT array - sorting with RESULT_DATE in reverse order. Ex: PSSGDT(-3170312,"CYP2C19","ACTIVITY_SCORE")=""
+2 ;PSSGENES array - Ex: PSSGENE(GENE,"GENE")
+3 NEW PSSLABDT,PSSGENE
+4 if '$DATA(PSSGDT)
QUIT
+5 SET PSSLABDT=""
FOR
SET PSSLABDT=$ORDER(PSSGDT(PSSLABDT))
if PSSLABDT=""
QUIT
Begin DoDot:1
+6 SET PSSGENE=""
FOR
SET PSSGENE=$ORDER(PSSGDT(PSSLABDT,PSSGENE))
if PSSGENE=""
QUIT
Begin DoDot:2
+7 ;Only keep a gene from the latest result_date
IF $DATA(PSSGENES(PSSGENE,"GENE"))
QUIT
+8 SET PSSGENES(PSSGENE,"GENE")=""
+9 SET PSSGENES(PSSGENE,"GENOTYPE")=$GET(PSSGDT(PSSLABDT,PSSGENE,"GENOTYPE"))
+10 SET PSSGENES(PSSGENE,"PHENOTYPE")=$GET(PSSGDT(PSSLABDT,PSSGENE,"PHENOTYPE"))
+11 SET PSSGENES(PSSGENE,"ACTIVITY_SCORE")=$GET(PSSGDT(PSSLABDT,PSSGENE,"ACTIVITY_SCORE"))
+12 SET PSSGENES(PSSGENE,"RESULT_DATE")=$GET(PSSGDT(PSSLABDT,PSSGENE,"RESULT_DATE"))
+13 SET PSSGENES(PSSGENE,"NPP_SharePointURL")=$GET(PSSGDT(PSSLABDT,PSSGENE,"NPP_SharePointURL"))
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
DTCNV(PSSEDT) ;Converse external date to Fileman internal date
+1 ;PSSEDT - External format (ex: 06/13/2024)
+2 NEW PSSFMDT
+3 if $GET(PSSEDT)=""
QUIT "ERROR"
+4 SET PSSFMDT=($PIECE(PSSEDT,"/",3)-1700)_$PIECE(PSSEDT,"/")_$PIECE(PSSEDT,"/",2)
+5 QUIT PSSFMDT
+6 ;
GENETBL(PSSGDT) ;
+1 NEW PSSGENE,PSSCNT,PSSAS,PSSLABDT,PSSGENTP
+2 if '$DATA(PSSGDT)
QUIT
+3 SET PSSGTBL(1)="The patient has the following PGx labs:"
+4 SET PSSGTBL(2)=""
+5 SET PSSGTBL(3)=" Activity"
+6 SET PSSGTBL(4)="Lab Date Gene Score Phenotype"
+7 SET PSSCNT=4
+8 SET PSSLABDT=""
FOR
SET PSSLABDT=$ORDER(PSSGDT(PSSLABDT))
if PSSLABDT=""
QUIT
Begin DoDot:1
+9 SET PSSGENE=""
FOR
SET PSSGENE=$ORDER(PSSGDT(PSSLABDT,PSSGENE))
if PSSGENE=""
QUIT
Begin DoDot:2
+10 SET PSSCNT=PSSCNT+1
+11 ;Result date
+12 SET PSSTXT=$$FMTE^XLFDT($EXTRACT(PSSLABDT,2,8),"5D")
+13 SET PSSTXT=PSSTXT_$$SPACES(PSSTXT,11)
+14 SET PSSGTBL(PSSCNT)=PSSTXT
+15 ;Gene - truncate to 12 char.
+16 SET PSSTXT=$EXTRACT(PSSGENE,1,12)_$$SPACES($EXTRACT(PSSGENE,1,12),13)
+17 SET PSSGTBL(PSSCNT)=PSSGTBL(PSSCNT)_PSSTXT
+18 ;Activity Score
+19 SET PSSAS=$GET(PSSGDT(PSSLABDT,PSSGENE,"ACTIVITY_SCORE"))
+20 SET PSSTXT=PSSAS_$$SPACES(PSSAS,5)
+21 SET PSSGTBL(PSSCNT)=PSSGTBL(PSSCNT)_PSSTXT
+22 ;Phenotype
+23 SET PSSTXT=$GET(PSSGDT(PSSLABDT,PSSGENE,"PHENOTYPE"))
+24 SET PSSGENTP=$GET(PSSGDT(PSSLABDT,PSSGENE,"GENOTYPE"))
IF PSSGENTP'=""
SET PSSTXT=PSSTXT_" (Genotype: "_PSSGENTP_")"
+25 DO PHENO(PSSTXT,1,49)
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
PHENO(PSSTXT,DIWL,DIWR) ;format phenotype (can be longer than 50 chars)
+1 NEW PSSX,PSSX1,PSSLINE,X
+2 SET X=$GET(PSSTXT)
+3 if '+$GET(PSSCNT)
SET PSSCNT=1
SET PSSGTBL(PSSCNT)=""
+4 IF '$GET(DIWL)
SET DIWL=1
+5 IF '$GET(DIWR)
SET DIWR=75
+6 KILL ^UTILITY($JOB,"W")
DO ^DIWP
+7 ;
+8 SET PSSX1=0
+9 FOR PSSX=0:0
SET PSSX=$ORDER(^UTILITY($JOB,"W",1,PSSX))
if 'PSSX
QUIT
Begin DoDot:1
+10 SET PSSTXT=$GET(^UTILITY($JOB,"W",1,PSSX,0))
SET PSSX1=PSSX1+1
+11 IF PSSTXT]""
Begin DoDot:2
+12 IF $LENGTH(PSSTXT)>49
SET PSSLINE(PSSX1)=$EXTRACT(PSSTXT,1,49)
SET PSSX1=PSSX1+1
SET PSSLINE(PSSX1)=$EXTRACT(PSSTXT,49,$LENGTH(PSSTXT))
+13 IF $LENGTH(PSSTXT)<50
SET PSSLINE(PSSX1)=PSSTXT
End DoDot:2
End DoDot:1
+14 ;
+15 FOR PSSX1=0:0
SET PSSX1=$ORDER(PSSLINE(PSSX1))
if 'PSSX1
QUIT
Begin DoDot:1
+16 IF PSSX1>1
SET PSSCNT=PSSCNT+1
SET PSSGTBL(PSSCNT)=""
+17 SET PSSGTBL(PSSCNT)=PSSGTBL(PSSCNT)_$$SPACES($GET(PSSGTBL(PSSCNT)),29)_PSSLINE(PSSX1)
End DoDot:1
+18 ;
+19 KILL ^UTILITY($JOB,"W"),DIWL,DIWR
+20 QUIT
+21 ;
SPACES(PSSTXT,PSSCHR) ;Add trailing spaces
+1 NEW PSSSPACE,PSSDIFF
+2 if '+$GET(PSSCHR)
QUIT ""
+3 SET PSSDIFF=PSSCHR-$LENGTH($GET(PSSTXT))
+4 if +PSSDIFF<1
QUIT ""
+5 SET $PIECE(PSSSPACE," ",PSSDIFF)=" "
+6 QUIT PSSSPACE
