PSSPGXU2 ;BIR/MV - PPHARMACOGENOMICS UTILITY ROUTINE CONT. ;09/20/07
;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
;
PGXEMAIL(PSSDFN,PSSICN,PSSRESUL,PSSINV) ;
;PSSDFN - Patient IEN
;PSSRESUL(N,"GENE")=GENE^UNRSOLVED GENE^1 (UNRESOLVED FLAG)
;PSSRESUL(N,"PHENOTYPE")=PHENOTYPE^UNRSOLVED PHENOTYPE^1 (UNRESOLVED FLAG)
;PSSINV - Unresolve gene/phenotype array
;PSSINV("G",N) - where N is xref in PSSRESUL array for Gene
;PSSINV("P",N) - where N is xref in PSSRESUL array for Phenotype
;Output: 1 if an email should be sent for unresolved gene/phenotype
;
NEW PSSCNT,PSSEMAIL,PSSGENE,PSSGFG,PSSINVX,PSSPFG,PSSPTYPE,PSSFMAIL,PSSEDT,X,X1,X2
;Group the phenotype under Gene
S PSSFMAIL=0
S X1=DT,X2=-7 D C^%DTC S PSSEDT=X
F PSSCNT=0:0 S PSSCNT=$O(PSSINV("G",PSSCNT)) Q:'PSSCNT S PSSINVX(PSSCNT,"G")=""
F PSSCNT=0:0 S PSSCNT=$O(PSSINV("P",PSSCNT)) Q:'PSSCNT S PSSINVX(PSSCNT,"P")=""
;Get pt's GENE & PHENOTYPE from lab
S PSSEMAIL=0
F PSSCNT=0:0 S PSSCNT=$O(PSSINVX(PSSCNT)) Q:'PSSCNT D
. S PSSGFG=$D(PSSINVX(PSSCNT,"G"))
. S PSSPFG=$D(PSSINVX(PSSCNT,"P"))
. S PSSGENE=$P($G(PSSRESUL(PSSCNT,"GENE")),U)
. S PSSPTYPE=""
. S:PSSPFG PSSPTYPE=$P($G(PSSRESUL(PSSCNT,"PHENOTYPE")),U)
. S PSSEMAIL=$$NEWMAIL() I PSSEMAIL S PSSFMAIL=1
Q PSSFMAIL
;
NEWMAIL() ;
;PSSMAIL - 1 to send email; 0 means email was sent within 7 days
;Check if email was send within 7 days ago
N PSSASEND
S PSSASEND=0
I PSSGFG D
.I '+$O(^PS(51.29,PSSDFN,1,"AG",PSSGENE,PSSEDT)) S PSSASEND=1 Q
.K PSSINV("G",PSSCNT)
I PSSPFG D
.I '+$O(^PS(51.29,PSSDFN,1,"AP",PSSGENE,PSSPTYPE,PSSEDT)),'$D(PSSRESUL(PSSCNT,"NOFDB")) S PSSASEND=1 Q
.K PSSINV("P",PSSCNT)
I PSSASEND Q 1
Q 0
;
EMAILDT(PSSDFN,PSSGENE,PSSPTYPE) ;
NEW PSSEDT,PSSEDTX
Q:$G(PSSDFN)="" ""
Q:$G(PSSGENE)="" ""
S PSSEDTX=""
I $G(PSSPTYPE)="" F PSSEDT=0:0 S PSSEDT=$O(^PS(51.29,PSSDFN,1,"AG",PSSGENE,PSSEDT)) Q:'PSSEDT D
. S PSSEDTX=PSSEDTX_$S(PSSEDTX]"":", ",1:"")_$$FMTE^XLFDT(PSSEDT,5)
I $G(PSSPTYPE)]"" F PSSEDT=0:0 S PSSEDT=$O(^PS(51.29,PSSDFN,1,"AP",PSSGENE,PSSPTYPE,PSSEDT)) Q:'PSSEDT D
. S PSSEDTX=PSSEDTX_$S(PSSEDTX]"":", ",1:"")_$$FMTE^XLFDT(PSSEDT,5)
Q PSSEDTX
;
WRT(PSSELOG,PSSDFN,PSSICN) ;Logging unresolvable gene/phenotype to 51.29 file
NEW DO,DIC,DINUM,X,DA,PSSGENE
I '$G(PSSDFN)!'+$G(PSSICN) Q
Q:'$D(PSSELOG)
;Add patient to file if needed
I '$D(^PS(51.29,PSSDFN)) D
. K DO S DIC="^PS(51.29,",DIC(0)="",(DINUM,X)=PSSDFN
. S DIC("DR")="1////"_PSSICN
. D FILE^DICN
Q:'$D(^PS(51.29,PSSDFN))
;
;Add unresolved Gene/Phenotype entry(s)
S PSSGENE="" F S PSSGENE=$O(PSSELOG(PSSGENE)) Q:PSSGENE="" D
. K DO S DIC="^PS(51.29,"_PSSDFN_",1,",DIC(0)="",DA(1)=PSSDFN,X=1
. ;P1=PHENOTYPE, P2=UNRESOLVED FLAG, P3=EMAIL DATE, P4=LOCATION, P5=PACKAGE
. S DIC("DR")=".01////"_PSSGENE_";1////"_$P(PSSELOG(PSSGENE),U,1)_";2////"_$P(PSSELOG(PSSGENE),U,2)_";3////"_$P(PSSELOG(PSSGENE),U,3)_";4////"_$P(PSSELOG(PSSGENE),U,4)_";5////"_$P(PSSELOG(PSSGENE),U,5)
. D FILE^DICN
Q
GENE() ;Getting genes for informative result from ^TMP("PSSPGXBS")
NEW PSSHGFG,PSSFG,PSS1,PSS2,PSS11,PSS22,PSSDRGCK,PSSGF,PSSGN,PSSDAIDX,PSSGNHG,PSSGNALL,PSSGENE,PSSDAID
S PSSHGFG=0,PSSFG=0,PSSGENE=""
S PSS1=0 F S PSS1=$O(^TMP("PSSPGXBS",$J,PSS1)) Q:'PSS1 D
. S PSS2=0 F S PSS2=$O(^TMP("PSSPGXBS",$J,PSS1,PSS2)) Q:'PSS2 D
.. I $G(^TMP("PSSPGXBS",$J,PSS1,PSS2))="pgxDrugChecks" D
... D MATCH(PSS1,PSS2,"pgxDrugCheck",.PSSDRGCK) ;10,78
... S PSS11=0 F S PSS11=$O(PSSDRGCK(PSS11)) Q:'PSS11 D
.... D MATCH(PSS1,PSS11,"genomicFinding",.PSSGF) ;10(12,19); 78(80)
.... S PSS22=0 F S PSS22=$O(PSSGF(PSS22)) Q:'PSS22 D
..... D MATCH(PSS1,PSS22,"gene",.PSSGN)
.. I $G(^TMP("PSSPGXBS",$J,PSS1,PSS2))="displayActionId" D
... S PSSDAID(PSS2)=$$VAL(PSS1,PSS2)
... S:+PSSDAID(PSS2)=1 PSSHGFG=1
... S:+PSSDAID(PSS2)'=1 PSSFG=1
. S PSS11=0 F S PSS11=$O(PSSGN(PSS11)) Q:'PSS11 S PSSGN(PSS11)=$$VAL(PSS1,PSS11)
;
I 'PSSFG,PSSHGFG Q "" ;Use PSSPHAR array for Interruptive display
;
S PSS11=0 F S PSS11=$O(PSSGN(PSS11)) Q:'PSS11 D
. S PSSDAIDX=$O(PSSDAID(PSS11))
. I PSS11<PSSDAIDX D
.. I PSSDAID(PSSDAIDX)=1 S PSSGNHG(PSS11)=PSSGN(PSS11) Q
.. S PSSGNALL(PSS11)=PSSGN(PSS11)
S PSS11=0 F S PSS11=$O(PSSGNALL(PSS11)) Q:'PSS11 D
. S PSSGENE=PSSGENE_$S(PSSGENE="":"",1:", ")_PSSGNALL(PSS11)
Q PSSGENE
;
MATCH(PSS1,PSS2,PSSTXT,PSSLST) ;
NEW PSSC1
I '+$G(PSS1)!'+$G(PSS2)!($G(PSSTXT)="") Q
F PSSC1=0:0 S PSSC1=$O(^TMP("PSSPGXBS",$J,PSS1,PSS2,"C",PSSC1)) Q:'PSSC1 D
. I +PSSC1,($G(^TMP("PSSPGXBS",$J,PSS1,PSS2,"C",PSSC1))=PSSTXT) S PSSLST(PSSC1)=""
Q
;
VAL(PSS1,PSS2) ;
NEW PSSVAL
I '+$G(PSS1)!'+$G(PSS2) Q
S PSSVAL=$G(^TMP("PSSPGXBS",$J,PSS1,PSS2,"T",1))
Q PSSVAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPGXU2 4765 printed Mar 25, 2026@15:58:17 Page 2
PSSPGXU2 ;BIR/MV - PPHARMACOGENOMICS UTILITY ROUTINE CONT. ;09/20/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
+2 ;
PGXEMAIL(PSSDFN,PSSICN,PSSRESUL,PSSINV) ;
+1 ;PSSDFN - Patient IEN
+2 ;PSSRESUL(N,"GENE")=GENE^UNRSOLVED GENE^1 (UNRESOLVED FLAG)
+3 ;PSSRESUL(N,"PHENOTYPE")=PHENOTYPE^UNRSOLVED PHENOTYPE^1 (UNRESOLVED FLAG)
+4 ;PSSINV - Unresolve gene/phenotype array
+5 ;PSSINV("G",N) - where N is xref in PSSRESUL array for Gene
+6 ;PSSINV("P",N) - where N is xref in PSSRESUL array for Phenotype
+7 ;Output: 1 if an email should be sent for unresolved gene/phenotype
+8 ;
+9 NEW PSSCNT,PSSEMAIL,PSSGENE,PSSGFG,PSSINVX,PSSPFG,PSSPTYPE,PSSFMAIL,PSSEDT,X,X1,X2
+10 ;Group the phenotype under Gene
+11 SET PSSFMAIL=0
+12 SET X1=DT
SET X2=-7
DO C^%DTC
SET PSSEDT=X
+13 FOR PSSCNT=0:0
SET PSSCNT=$ORDER(PSSINV("G",PSSCNT))
if 'PSSCNT
QUIT
SET PSSINVX(PSSCNT,"G")=""
+14 FOR PSSCNT=0:0
SET PSSCNT=$ORDER(PSSINV("P",PSSCNT))
if 'PSSCNT
QUIT
SET PSSINVX(PSSCNT,"P")=""
+15 ;Get pt's GENE & PHENOTYPE from lab
+16 SET PSSEMAIL=0
+17 FOR PSSCNT=0:0
SET PSSCNT=$ORDER(PSSINVX(PSSCNT))
if 'PSSCNT
QUIT
Begin DoDot:1
+18 SET PSSGFG=$DATA(PSSINVX(PSSCNT,"G"))
+19 SET PSSPFG=$DATA(PSSINVX(PSSCNT,"P"))
+20 SET PSSGENE=$PIECE($GET(PSSRESUL(PSSCNT,"GENE")),U)
+21 SET PSSPTYPE=""
+22 if PSSPFG
SET PSSPTYPE=$PIECE($GET(PSSRESUL(PSSCNT,"PHENOTYPE")),U)
+23 SET PSSEMAIL=$$NEWMAIL()
IF PSSEMAIL
SET PSSFMAIL=1
End DoDot:1
+24 QUIT PSSFMAIL
+25 ;
NEWMAIL() ;
+1 ;PSSMAIL - 1 to send email; 0 means email was sent within 7 days
+2 ;Check if email was send within 7 days ago
+3 NEW PSSASEND
+4 SET PSSASEND=0
+5 IF PSSGFG
Begin DoDot:1
+6 IF '+$ORDER(^PS(51.29,PSSDFN,1,"AG",PSSGENE,PSSEDT))
SET PSSASEND=1
QUIT
+7 KILL PSSINV("G",PSSCNT)
End DoDot:1
+8 IF PSSPFG
Begin DoDot:1
+9 IF '+$ORDER(^PS(51.29,PSSDFN,1,"AP",PSSGENE,PSSPTYPE,PSSEDT))
IF '$DATA(PSSRESUL(PSSCNT,"NOFDB"))
SET PSSASEND=1
QUIT
+10 KILL PSSINV("P",PSSCNT)
End DoDot:1
+11 IF PSSASEND
QUIT 1
+12 QUIT 0
+13 ;
EMAILDT(PSSDFN,PSSGENE,PSSPTYPE) ;
+1 NEW PSSEDT,PSSEDTX
+2 if $GET(PSSDFN)=""
QUIT ""
+3 if $GET(PSSGENE)=""
QUIT ""
+4 SET PSSEDTX=""
+5 IF $GET(PSSPTYPE)=""
FOR PSSEDT=0:0
SET PSSEDT=$ORDER(^PS(51.29,PSSDFN,1,"AG",PSSGENE,PSSEDT))
if 'PSSEDT
QUIT
Begin DoDot:1
+6 SET PSSEDTX=PSSEDTX_$SELECT(PSSEDTX]"":", ",1:"")_$$FMTE^XLFDT(PSSEDT,5)
End DoDot:1
+7 IF $GET(PSSPTYPE)]""
FOR PSSEDT=0:0
SET PSSEDT=$ORDER(^PS(51.29,PSSDFN,1,"AP",PSSGENE,PSSPTYPE,PSSEDT))
if 'PSSEDT
QUIT
Begin DoDot:1
+8 SET PSSEDTX=PSSEDTX_$SELECT(PSSEDTX]"":", ",1:"")_$$FMTE^XLFDT(PSSEDT,5)
End DoDot:1
+9 QUIT PSSEDTX
+10 ;
WRT(PSSELOG,PSSDFN,PSSICN) ;Logging unresolvable gene/phenotype to 51.29 file
+1 NEW DO,DIC,DINUM,X,DA,PSSGENE
+2 IF '$GET(PSSDFN)!'+$GET(PSSICN)
QUIT
+3 if '$DATA(PSSELOG)
QUIT
+4 ;Add patient to file if needed
+5 IF '$DATA(^PS(51.29,PSSDFN))
Begin DoDot:1
+6 KILL DO
SET DIC="^PS(51.29,"
SET DIC(0)=""
SET (DINUM,X)=PSSDFN
+7 SET DIC("DR")="1////"_PSSICN
+8 DO FILE^DICN
End DoDot:1
+9 if '$DATA(^PS(51.29,PSSDFN))
QUIT
+10 ;
+11 ;Add unresolved Gene/Phenotype entry(s)
+12 SET PSSGENE=""
FOR
SET PSSGENE=$ORDER(PSSELOG(PSSGENE))
if PSSGENE=""
QUIT
Begin DoDot:1
+13 KILL DO
SET DIC="^PS(51.29,"_PSSDFN_",1,"
SET DIC(0)=""
SET DA(1)=PSSDFN
SET X=1
+14 ;P1=PHENOTYPE, P2=UNRESOLVED FLAG, P3=EMAIL DATE, P4=LOCATION, P5=PACKAGE
+15 SET DIC("DR")=".01////"_PSSGENE_";1////"_$PIECE(PSSELOG(PSSGENE),U,1)_";2////"_$PIECE(PSSELOG(PSSGENE),U,2)_";3////"_$PIECE(PSSELOG(PSSGENE),U,3)_";4////"_$PIECE(PSSELOG(PSSGENE),U,4)_";5////"_$PIECE(PSSELOG(PSSGENE),U,5)
+16 DO FILE^DICN
End DoDot:1
+17 QUIT
GENE() ;Getting genes for informative result from ^TMP("PSSPGXBS")
+1 NEW PSSHGFG,PSSFG,PSS1,PSS2,PSS11,PSS22,PSSDRGCK,PSSGF,PSSGN,PSSDAIDX,PSSGNHG,PSSGNALL,PSSGENE,PSSDAID
+2 SET PSSHGFG=0
SET PSSFG=0
SET PSSGENE=""
+3 SET PSS1=0
FOR
SET PSS1=$ORDER(^TMP("PSSPGXBS",$JOB,PSS1))
if 'PSS1
QUIT
Begin DoDot:1
+4 SET PSS2=0
FOR
SET PSS2=$ORDER(^TMP("PSSPGXBS",$JOB,PSS1,PSS2))
if 'PSS2
QUIT
Begin DoDot:2
+5 IF $GET(^TMP("PSSPGXBS",$JOB,PSS1,PSS2))="pgxDrugChecks"
Begin DoDot:3
+6 ;10,78
DO MATCH(PSS1,PSS2,"pgxDrugCheck",.PSSDRGCK)
+7 SET PSS11=0
FOR
SET PSS11=$ORDER(PSSDRGCK(PSS11))
if 'PSS11
QUIT
Begin DoDot:4
+8 ;10(12,19); 78(80)
DO MATCH(PSS1,PSS11,"genomicFinding",.PSSGF)
+9 SET PSS22=0
FOR
SET PSS22=$ORDER(PSSGF(PSS22))
if 'PSS22
QUIT
Begin DoDot:5
+10 DO MATCH(PSS1,PSS22,"gene",.PSSGN)
End DoDot:5
End DoDot:4
End DoDot:3
+11 IF $GET(^TMP("PSSPGXBS",$JOB,PSS1,PSS2))="displayActionId"
Begin DoDot:3
+12 SET PSSDAID(PSS2)=$$VAL(PSS1,PSS2)
+13 if +PSSDAID(PSS2)=1
SET PSSHGFG=1
+14 if +PSSDAID(PSS2)'=1
SET PSSFG=1
End DoDot:3
End DoDot:2
+15 SET PSS11=0
FOR
SET PSS11=$ORDER(PSSGN(PSS11))
if 'PSS11
QUIT
SET PSSGN(PSS11)=$$VAL(PSS1,PSS11)
End DoDot:1
+16 ;
+17 ;Use PSSPHAR array for Interruptive display
IF 'PSSFG
IF PSSHGFG
QUIT ""
+18 ;
+19 SET PSS11=0
FOR
SET PSS11=$ORDER(PSSGN(PSS11))
if 'PSS11
QUIT
Begin DoDot:1
+20 SET PSSDAIDX=$ORDER(PSSDAID(PSS11))
+21 IF PSS11<PSSDAIDX
Begin DoDot:2
+22 IF PSSDAID(PSSDAIDX)=1
SET PSSGNHG(PSS11)=PSSGN(PSS11)
QUIT
+23 SET PSSGNALL(PSS11)=PSSGN(PSS11)
End DoDot:2
End DoDot:1
+24 SET PSS11=0
FOR
SET PSS11=$ORDER(PSSGNALL(PSS11))
if 'PSS11
QUIT
Begin DoDot:1
+25 SET PSSGENE=PSSGENE_$SELECT(PSSGENE="":"",1:", ")_PSSGNALL(PSS11)
End DoDot:1
+26 QUIT PSSGENE
+27 ;
MATCH(PSS1,PSS2,PSSTXT,PSSLST) ;
+1 NEW PSSC1
+2 IF '+$GET(PSS1)!'+$GET(PSS2)!($GET(PSSTXT)="")
QUIT
+3 FOR PSSC1=0:0
SET PSSC1=$ORDER(^TMP("PSSPGXBS",$JOB,PSS1,PSS2,"C",PSSC1))
if 'PSSC1
QUIT
Begin DoDot:1
+4 IF +PSSC1
IF ($GET(^TMP("PSSPGXBS",$JOB,PSS1,PSS2,"C",PSSC1))=PSSTXT)
SET PSSLST(PSSC1)=""
End DoDot:1
+5 QUIT
+6 ;
VAL(PSS1,PSS2) ;
+1 NEW PSSVAL
+2 IF '+$GET(PSS1)!'+$GET(PSS2)
QUIT
+3 SET PSSVAL=$GET(^TMP("PSSPGXBS",$JOB,PSS1,PSS2,"T",1))
+4 QUIT PSSVAL
