PSJOCPGX ;BIR/MV - PGx ORDER CHECKS DRIVER ; 9/10/14 10:53pm
;;5.0;INPATIENT MEDICATIONS;**447**;16 DEC 97;Build 49
;
; Reference to PGXOC^PSSPGX is supported by ICR #7526.
;
EN(PSJPDRG) ;
NEW PSJDRGS,PSJX,PSJDIEN,PSSOUT
;PSJDIEN(DRUGNAME)=DRUG IEN
Q:+$G(PSJDGCK) ;Not perform PGx OC from Check Interactions hidden action yet. PSJPDRG may still hang around from the CK action.
F X=0:0 S X=$O(PSJPDRG(X)) Q:'X S PSJX=PSJPDRG(X),PSJDRGS(+PSJX)="",PSJDRGS(+PSJX,"DRUGNAME")=$P(PSJX,U,2),PSJDIEN($P(PSJX,U,2))=+PSJX
K PSJX
Q:'$D(PSJDRGS)
D PGXOC^PSSPGX("PSJPGX",DFN,.PSJDRGS,.PSSOUT,"I")
I $D(^TMP($J,"PSSXWARN")) D DISPLAY K ^TMP($J,"PSSXWARN")
Q
DISPLAY ;
NEW PSJTYPE,PSJSUB,PSJDD,PSJDNM,PSJUSER,PSJEFLG
S PSJUSER=$S(+$G(PSJSYSU)=3:1,+$G(PSJSYSU)=1:1,1:0)
F PSJTYPE="ERROR","HIGH","MEDIUM","NONE" D Q:$G(PSGORQF)
. F PSJSUB=0:0 S PSJSUB=$O(^TMP($J,"PSSXWARN",PSJTYPE,PSJSUB)) Q:'PSJSUB Q:$G(PSGORQF) D
.. S PSJDD=""
.. W:'+$G(PSJEFLG) @IOF K PSJEFLG ;If only an error is returned, don't refresh the screen.
.. D DISPPGX
.. I (PSJTYPE="HIGH") D ADDINFO(PSJTYPE,PSJSUB) I PSJUSER D RINTERV^PSJGMRA("PHARMACOGENOMIC HIGH ORDER CHECK",$G(PSJDNM)) W ! Q
.. I (PSJTYPE="MEDIUM") D ADDINFO(PSJTYPE,PSJSUB) I PSJUSER D INTERV^PSJGMRA("PHARMACOGENOMIC MEDIUM ORDER CHECK",$G(PSJDNM)) W ! Q
I '+$G(PSGORQF) W ! D PAUSE^PSJLMUT1
Q
DISPPGX ;
NEW PSJTXT,PSJCNT
F PSJCNT=0:0 S PSJCNT=$O(^TMP($J,"PSSXWARN",PSJTYPE,PSJSUB,PSJCNT)) Q:'PSJCNT D
. I (PSJTYPE="ERROR"),'$O(^TMP($J,"PSSXWARN",PSJTYPE)) S PSJEFLG=1
. S PSJTXT=^TMP($J,"PSSXWARN",PSJTYPE,PSJSUB,PSJCNT)
. I PSJTXT["IMPACTED MEDICATION" S PSJDNM=$P(PSJTXT,": ",2),PSJDD=+$G(PSJDIEN(PSJDNM))
. I (PSJTXT["For more details"),(($Y+5)>IOSL) W ! D PAUSE^PSJLMUT1 W @IOF
. I ($Y+4)>IOSL W ! D PAUSE^PSJLMUT1 W @IOF
.W !,PSJTXT
;If the last error has displayed, issue a Press return.
I +$O(^TMP($J,"PSSXWARN",PSJTYPE,PSJSUB)) W ! D PAUSE^PSJLMUT1
Q
ADDINFO(PSJTYPE,PSJSUB) ;Display additional information
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTREQ
I $G(PSJTYPE)=""!'+$G(PSJSUB) Q
Q:'$$ASK()
K IOP,%ZIS,POP S %ZIS="QM" W ! D ^%ZIS
I POP K SEL,DIR,DTOUT,DUOUT,DIRUT,MONT W !,"NOTHING PRINTED",! Q
I $D(IO("Q")) D Q
.S ZTRTN="AIPRT^PSJOCPGX",ZTDESC="Pharmacogenomic Order Check - Additional Information"
.S ZTSAVE("PSJTYPE")="",ZTSAVE("PSJSUB")="",ZTSAVE("^TMP($J,""PSSXWARN"",")=""
.D ^%ZTLOAD,^%ZISC D
..W:'$D(ZTSK) $C(7)," (Task NOT queued.)"
..W:$D(ZTSK) !,"Pharmacogenomic Additional Information Queued to Print!",!
..S:$D(ZTQUEUED) ZTREQ="Q"
D AIPRT,^%ZISC
Q
ASK() ;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 wish to display the additional information for Pharmacogenomic Order Check"
D ^DIR
I 'Y W ! Q 0
Q 1
;
AIPRT ;
NEW PSJCNT,PSJLINE,PSJQUIT,DIR
I $G(PSJTYPE)=""!'+$G(PSJSUB) Q
I $E(IOST)="C" D FULL^VALM1
S PSJQUIT=0
F PSJCNT=0:0 S PSJCNT=$O(^TMP($J,"PSSXWARN",PSJTYPE,PSJSUB,"AI",PSJCNT)) Q:'PSJCNT Q:PSJQUIT D
. S PSJLINE=1
. W !,^TMP($J,"PSSXWARN",PSJTYPE,PSJSUB,"AI",PSJCNT)
. I $Y+4>IOSL,$E(IOST)="C" W ! D PAUSE^VALM1 S:$G(X)="^" PSJQUIT=1 W @IOF
W:$G(PSJLINE) !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJOCPGX 3296 printed Jan 29, 2026@15:06:40 Page 2
PSJOCPGX ;BIR/MV - PGx ORDER CHECKS DRIVER ; 9/10/14 10:53pm
+1 ;;5.0;INPATIENT MEDICATIONS;**447**;16 DEC 97;Build 49
+2 ;
+3 ; Reference to PGXOC^PSSPGX is supported by ICR #7526.
+4 ;
EN(PSJPDRG) ;
+1 NEW PSJDRGS,PSJX,PSJDIEN,PSSOUT
+2 ;PSJDIEN(DRUGNAME)=DRUG IEN
+3 ;Not perform PGx OC from Check Interactions hidden action yet. PSJPDRG may still hang around from the CK action.
if +$GET(PSJDGCK)
QUIT
+4 FOR X=0:0
SET X=$ORDER(PSJPDRG(X))
if 'X
QUIT
SET PSJX=PSJPDRG(X)
SET PSJDRGS(+PSJX)=""
SET PSJDRGS(+PSJX,"DRUGNAME")=$PIECE(PSJX,U,2)
SET PSJDIEN($PIECE(PSJX,U,2))=+PSJX
+5 KILL PSJX
+6 if '$DATA(PSJDRGS)
QUIT
+7 DO PGXOC^PSSPGX("PSJPGX",DFN,.PSJDRGS,.PSSOUT,"I")
+8 IF $DATA(^TMP($JOB,"PSSXWARN"))
DO DISPLAY
KILL ^TMP($JOB,"PSSXWARN")
+9 QUIT
DISPLAY ;
+1 NEW PSJTYPE,PSJSUB,PSJDD,PSJDNM,PSJUSER,PSJEFLG
+2 SET PSJUSER=$SELECT(+$GET(PSJSYSU)=3:1,+$GET(PSJSYSU)=1:1,1:0)
+3 FOR PSJTYPE="ERROR","HIGH","MEDIUM","NONE"
Begin DoDot:1
+4 FOR PSJSUB=0:0
SET PSJSUB=$ORDER(^TMP($JOB,"PSSXWARN",PSJTYPE,PSJSUB))
if 'PSJSUB
QUIT
if $GET(PSGORQF)
QUIT
Begin DoDot:2
+5 SET PSJDD=""
+6 ;If only an error is returned, don't refresh the screen.
if '+$GET(PSJEFLG)
WRITE @IOF
KILL PSJEFLG
+7 DO DISPPGX
+8 IF (PSJTYPE="HIGH")
DO ADDINFO(PSJTYPE,PSJSUB)
IF PSJUSER
DO RINTERV^PSJGMRA("PHARMACOGENOMIC HIGH ORDER CHECK",$GET(PSJDNM))
WRITE !
QUIT
+9 IF (PSJTYPE="MEDIUM")
DO ADDINFO(PSJTYPE,PSJSUB)
IF PSJUSER
DO INTERV^PSJGMRA("PHARMACOGENOMIC MEDIUM ORDER CHECK",$GET(PSJDNM))
WRITE !
QUIT
End DoDot:2
End DoDot:1
if $GET(PSGORQF)
QUIT
+10 IF '+$GET(PSGORQF)
WRITE !
DO PAUSE^PSJLMUT1
+11 QUIT
DISPPGX ;
+1 NEW PSJTXT,PSJCNT
+2 FOR PSJCNT=0:0
SET PSJCNT=$ORDER(^TMP($JOB,"PSSXWARN",PSJTYPE,PSJSUB,PSJCNT))
if 'PSJCNT
QUIT
Begin DoDot:1
+3 IF (PSJTYPE="ERROR")
IF '$ORDER(^TMP($JOB,"PSSXWARN",PSJTYPE))
SET PSJEFLG=1
+4 SET PSJTXT=^TMP($JOB,"PSSXWARN",PSJTYPE,PSJSUB,PSJCNT)
+5 IF PSJTXT["IMPACTED MEDICATION"
SET PSJDNM=$PIECE(PSJTXT,": ",2)
SET PSJDD=+$GET(PSJDIEN(PSJDNM))
+6 IF (PSJTXT["For more details")
IF (($Y+5)>IOSL)
WRITE !
DO PAUSE^PSJLMUT1
WRITE @IOF
+7 IF ($Y+4)>IOSL
WRITE !
DO PAUSE^PSJLMUT1
WRITE @IOF
+8 WRITE !,PSJTXT
End DoDot:1
+9 ;If the last error has displayed, issue a Press return.
+10 IF +$ORDER(^TMP($JOB,"PSSXWARN",PSJTYPE,PSJSUB))
WRITE !
DO PAUSE^PSJLMUT1
+11 QUIT
ADDINFO(PSJTYPE,PSJSUB) ;Display additional information
+1 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTREQ
+2 IF $GET(PSJTYPE)=""!'+$GET(PSJSUB)
QUIT
+3 if '$$ASK()
QUIT
+4 KILL IOP,%ZIS,POP
SET %ZIS="QM"
WRITE !
DO ^%ZIS
+5 IF POP
KILL SEL,DIR,DTOUT,DUOUT,DIRUT,MONT
WRITE !,"NOTHING PRINTED",!
QUIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTRTN="AIPRT^PSJOCPGX"
SET ZTDESC="Pharmacogenomic Order Check - Additional Information"
+8 SET ZTSAVE("PSJTYPE")=""
SET ZTSAVE("PSJSUB")=""
SET ZTSAVE("^TMP($J,""PSSXWARN"",")=""
+9 DO ^%ZTLOAD
DO ^%ZISC
Begin DoDot:2
+10 if '$DATA(ZTSK)
WRITE $CHAR(7)," (Task NOT queued.)"
+11 if $DATA(ZTSK)
WRITE !,"Pharmacogenomic Additional Information Queued to Print!",!
+12 if $DATA(ZTQUEUED)
SET ZTREQ="Q"
End DoDot:2
End DoDot:1
QUIT
+13 DO AIPRT
DO ^%ZISC
+14 QUIT
ASK() ;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 wish to display the additional information for Pharmacogenomic Order Check"
+4 DO ^DIR
+5 IF 'Y
WRITE !
QUIT 0
+6 QUIT 1
+7 ;
AIPRT ;
+1 NEW PSJCNT,PSJLINE,PSJQUIT,DIR
+2 IF $GET(PSJTYPE)=""!'+$GET(PSJSUB)
QUIT
+3 IF $EXTRACT(IOST)="C"
DO FULL^VALM1
+4 SET PSJQUIT=0
+5 FOR PSJCNT=0:0
SET PSJCNT=$ORDER(^TMP($JOB,"PSSXWARN",PSJTYPE,PSJSUB,"AI",PSJCNT))
if 'PSJCNT
QUIT
if PSJQUIT
QUIT
Begin DoDot:1
+6 SET PSJLINE=1
+7 WRITE !,^TMP($JOB,"PSSXWARN",PSJTYPE,PSJSUB,"AI",PSJCNT)
+8 IF $Y+4>IOSL
IF $EXTRACT(IOST)="C"
WRITE !
DO PAUSE^VALM1
if $GET(X)="^"
SET PSJQUIT=1
WRITE @IOF
End DoDot:1
+9 if $GET(PSJLINE)
WRITE !
+10 QUIT
