PSSPGXP2 ;BIR/RTR - PHARMACOGENOMICS PRODUCTION ORDER CHECK #2;09/20/07
;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
;
; Reference to EHCHK^PSJORUT2 is supported by ICR #2376
; Reference to BLD^PSOOCPGX is supported by ICR #7527
;
FORMATAI(X,PSSRMG,PSSWGLF,PSSPHDS,PSSPHDLF) ;
N PSSW1,PSSW2,PSSAILC,PSSPHDSS,PSSUT,PSSUTL
S PSSUT=79-PSSRMG F PSSUTL=1:1:PSSUT S PSSPHDSS=$G(PSSPHDSS)_" "
S DIWL=1,DIWR=PSSRMG,DIWF=""
K ^UTILITY($J,"W")
D ^DIWP
I PSSWGLF S PSSAILC=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,"AI",PSSAIC)=$S(PSSAILC=1:PSSPHDS,1:PSSPHDSS)_$G(^UTILITY($J,"W",PSSW1,PSSW2,0)) S PSSAILC=PSSAILC+1 D INCA^PSSPGXPR
I '$G(PSSWGLF) 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
..I $G(^UTILITY($J,"W",PSSW1,PSSW2,0))'="" S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,"AI",PSSAIC)=$G(^UTILITY($J,"W",PSSW1,PSSW2,0)) D INCA^PSSPGXPR
K ^UTILITY($J,"W")
I $G(PSSPHDLF) Q
I '$G(PSSWGLF) D LINE^PSSPGXPR
Q
;
ORAI(PSORMESS) ;
I $G(PSORMESS)'="ACTION LONG",$G(PSORMESS)'="RATIONALE LONG",$G(PSORMESS)'="MONITORING LONG" Q
S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,"AI",PSSAIC)=$P(PSORMESS," ")_":" D INCA^PSSPGXPR
S PSSRCEVL=$G(PSSPHAR(PSSSUB1,PSSXL,PSORMESS))
I $G(PSSPGXOR) S ^TMP($J,"PSSXWARN",PSSACT,PSSXL,"AI",PSSAIC)=PSSRCEVL D INCA^PSSPGXPR,LINE^PSSPGXPR Q
D FORMATAI(PSSRCEVL,79,0)
Q
;
SUP(PSSSPRDG) ;Suppress PGx order check based on Profile Meds
I '$G(PSSSPRDG) Q 0
N PSSSPRN1,PSSSPRN3,PSSSPRNN,PSSSPRIN,PSSSPRL,PSSSPRFL,PSSSINDX,PSSSPRDA,PSSSPRDC,PSSSPRDN,PSSSPRX,PSSSPRDX,PSSSPRZ,PSSSPRZZ
S PSSSPRNN=$G(^PSDRUG(PSSSPRDG,"ND"))
S PSSSPRN1=$P(PSSSPRNN,"^"),PSSSPRN3=$P(PSSSPRNN,"^",3)
I 'PSSSPRN1!('PSSSPRN3) Q 0
D PGXING^PSNAPIS(PSSSPRN1,PSSSPRN3,.PSSSPRIN)
S PSSSPRL="" F S PSSSPRL=$O(PSSSPRIN("ING",PSSSPRL)) Q:PSSSPRL="" D
.I $P(PSSSPRIN("ING",PSSSPRL),"^",2),$P(PSSSPRIN("ING",PSSSPRL),"^",3) Q
.K PSSSPRIN("ING",PSSSPRL)
I '$D(PSSSPRIN) Q 0
S (PSSSPRFL,PSSSINDX)=0
I PSSPGXPK="I" D SUPIN I PSSSPRFL Q 1
D SUPOU I PSSSPRFL Q 1
Q 0
;
SUPIN ;Check Inpatient profile, no need for status check
K ^TMP($J,"ORDERS"),PSSSPRZ
D ENCHK^PSJORUT2(PSSDFN,0)
D CHECK K ^TMP($J,"ORDERS")
Q
;
SUPOU ;Check Outpatient profile - rx's only, no need for status check
K ^TMP($J,"ORDERS")
D BLD^PSOOCPGX(PSSDFN,90)
D CHECK K ^TMP($J,"ORDERS")
Q
;
CHECK ;
N PSSSPRZ
S PSSSINDX="" F S PSSSINDX=$O(^TMP($J,"ORDERS",PSSSINDX)) Q:PSSSINDX=""!(PSSSPRFL) D
.S PSSSPRDA=$G(^TMP($J,"ORDERS",PSSSINDX))
.I $P(PSSSPRDA,"^",5)["P" Q
.S PSSSPRDC=$P(PSSSPRDA,"^",2),PSSSPRDX=$P(PSSSPRDC,"A"),PSSSPRDN=$P(PSSSPRDC,"A",2) Q:'PSSSPRDN
.I '$P($$PGX^PSNAPIS(PSSSPRDX,PSSSPRDN),"^") Q
.K PSSSPRZ S PSSSPRX=$$PSJING^PSNAPIS(PSSSPRDX,PSSSPRDN,.PSSSPRZ)
.S PSSSPRZZ="" F S PSSSPRZZ=$O(PSSSPRZ(PSSSPRZZ)) Q:PSSSPRZZ=""!(PSSSPRFL) I $D(PSSSPRIN("ING",PSSSPRZZ)) S PSSSPRFL=1
K ^TMP($J,"ORDERS")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPGXP2 3120 printed Mar 25, 2026@15:58:13 Page 2
PSSPGXP2 ;BIR/RTR - PHARMACOGENOMICS PRODUCTION ORDER CHECK #2;09/20/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**262**;9/30/97;Build 66
+2 ;
+3 ; Reference to EHCHK^PSJORUT2 is supported by ICR #2376
+4 ; Reference to BLD^PSOOCPGX is supported by ICR #7527
+5 ;
FORMATAI(X,PSSRMG,PSSWGLF,PSSPHDS,PSSPHDLF) ;
+1 NEW PSSW1,PSSW2,PSSAILC,PSSPHDSS,PSSUT,PSSUTL
+2 SET PSSUT=79-PSSRMG
FOR PSSUTL=1:1:PSSUT
SET PSSPHDSS=$GET(PSSPHDSS)_" "
+3 SET DIWL=1
SET DIWR=PSSRMG
SET DIWF=""
+4 KILL ^UTILITY($JOB,"W")
+5 DO ^DIWP
+6 IF PSSWGLF
SET PSSAILC=1
Begin DoDot:1
+7 SET PSSW1=""
FOR
SET PSSW1=$ORDER(^UTILITY($JOB,"W",PSSW1))
if PSSW1=""
QUIT
Begin DoDot:2
+8 SET PSSW2=""
FOR
SET PSSW2=$ORDER(^UTILITY($JOB,"W",PSSW1,PSSW2))
if PSSW2=""
QUIT
Begin DoDot:3
+9 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,"AI",PSSAIC)=$SELECT(PSSAILC=1:PSSPHDS,1:PSSPHDSS)_$GET(^UTILITY($JOB,"W",PSSW1,PSSW2,0))
SET PSSAILC=PSSAILC+1
DO INCA^PSSPGXPR
End DoDot:3
End DoDot:2
End DoDot:1
+10 IF '$GET(PSSWGLF)
SET PSSW1=""
FOR
SET PSSW1=$ORDER(^UTILITY($JOB,"W",PSSW1))
if PSSW1=""
QUIT
Begin DoDot:1
+11 SET PSSW2=""
FOR
SET PSSW2=$ORDER(^UTILITY($JOB,"W",PSSW1,PSSW2))
if PSSW2=""
QUIT
Begin DoDot:2
+12 IF $GET(^UTILITY($JOB,"W",PSSW1,PSSW2,0))'=""
SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,"AI",PSSAIC)=$GET(^UTILITY($JOB,"W",PSSW1,PSSW2,0))
DO INCA^PSSPGXPR
End DoDot:2
End DoDot:1
+13 KILL ^UTILITY($JOB,"W")
+14 IF $GET(PSSPHDLF)
QUIT
+15 IF '$GET(PSSWGLF)
DO LINE^PSSPGXPR
+16 QUIT
+17 ;
ORAI(PSORMESS) ;
+1 IF $GET(PSORMESS)'="ACTION LONG"
IF $GET(PSORMESS)'="RATIONALE LONG"
IF $GET(PSORMESS)'="MONITORING LONG"
QUIT
+2 SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,"AI",PSSAIC)=$PIECE(PSORMESS," ")_":"
DO INCA^PSSPGXPR
+3 SET PSSRCEVL=$GET(PSSPHAR(PSSSUB1,PSSXL,PSORMESS))
+4 IF $GET(PSSPGXOR)
SET ^TMP($JOB,"PSSXWARN",PSSACT,PSSXL,"AI",PSSAIC)=PSSRCEVL
DO INCA^PSSPGXPR
DO LINE^PSSPGXPR
QUIT
+5 DO FORMATAI(PSSRCEVL,79,0)
+6 QUIT
+7 ;
SUP(PSSSPRDG) ;Suppress PGx order check based on Profile Meds
+1 IF '$GET(PSSSPRDG)
QUIT 0
+2 NEW PSSSPRN1,PSSSPRN3,PSSSPRNN,PSSSPRIN,PSSSPRL,PSSSPRFL,PSSSINDX,PSSSPRDA,PSSSPRDC,PSSSPRDN,PSSSPRX,PSSSPRDX,PSSSPRZ,PSSSPRZZ
+3 SET PSSSPRNN=$GET(^PSDRUG(PSSSPRDG,"ND"))
+4 SET PSSSPRN1=$PIECE(PSSSPRNN,"^")
SET PSSSPRN3=$PIECE(PSSSPRNN,"^",3)
+5 IF 'PSSSPRN1!('PSSSPRN3)
QUIT 0
+6 DO PGXING^PSNAPIS(PSSSPRN1,PSSSPRN3,.PSSSPRIN)
+7 SET PSSSPRL=""
FOR
SET PSSSPRL=$ORDER(PSSSPRIN("ING",PSSSPRL))
if PSSSPRL=""
QUIT
Begin DoDot:1
+8 IF $PIECE(PSSSPRIN("ING",PSSSPRL),"^",2)
IF $PIECE(PSSSPRIN("ING",PSSSPRL),"^",3)
QUIT
+9 KILL PSSSPRIN("ING",PSSSPRL)
End DoDot:1
+10 IF '$DATA(PSSSPRIN)
QUIT 0
+11 SET (PSSSPRFL,PSSSINDX)=0
+12 IF PSSPGXPK="I"
DO SUPIN
IF PSSSPRFL
QUIT 1
+13 DO SUPOU
IF PSSSPRFL
QUIT 1
+14 QUIT 0
+15 ;
SUPIN ;Check Inpatient profile, no need for status check
+1 KILL ^TMP($JOB,"ORDERS"),PSSSPRZ
+2 DO ENCHK^PSJORUT2(PSSDFN,0)
+3 DO CHECK
KILL ^TMP($JOB,"ORDERS")
+4 QUIT
+5 ;
SUPOU ;Check Outpatient profile - rx's only, no need for status check
+1 KILL ^TMP($JOB,"ORDERS")
+2 DO BLD^PSOOCPGX(PSSDFN,90)
+3 DO CHECK
KILL ^TMP($JOB,"ORDERS")
+4 QUIT
+5 ;
CHECK ;
+1 NEW PSSSPRZ
+2 SET PSSSINDX=""
FOR
SET PSSSINDX=$ORDER(^TMP($JOB,"ORDERS",PSSSINDX))
if PSSSINDX=""!(PSSSPRFL)
QUIT
Begin DoDot:1
+3 SET PSSSPRDA=$GET(^TMP($JOB,"ORDERS",PSSSINDX))
+4 IF $PIECE(PSSSPRDA,"^",5)["P"
QUIT
+5 SET PSSSPRDC=$PIECE(PSSSPRDA,"^",2)
SET PSSSPRDX=$PIECE(PSSSPRDC,"A")
SET PSSSPRDN=$PIECE(PSSSPRDC,"A",2)
if 'PSSSPRDN
QUIT
+6 IF '$PIECE($$PGX^PSNAPIS(PSSSPRDX,PSSSPRDN),"^")
QUIT
+7 KILL PSSSPRZ
SET PSSSPRX=$$PSJING^PSNAPIS(PSSSPRDX,PSSSPRDN,.PSSSPRZ)
+8 SET PSSSPRZZ=""
FOR
SET PSSSPRZZ=$ORDER(PSSSPRZ(PSSSPRZZ))
if PSSSPRZZ=""!(PSSSPRFL)
QUIT
IF $DATA(PSSSPRIN("ING",PSSSPRZZ))
SET PSSSPRFL=1
End DoDot:1
+9 KILL ^TMP($JOB,"ORDERS")
+10 QUIT
