PSOOCPGX ;BIR/KML - OUTPATIENT PHARMACY PGx ORDER CHECKS DRIVER ;9/10/14 10:53pm
;;7.0;OUTPATIENT PHARMACY;**737**;DEC 1997;Build 52
;
;External reference to PGXOC^PSSPGX is supported by ICR #7526
;External reference to $$PROD0^PSNAPIS(P1,P3) supported by ICR #2531
;External reference to $$PGX^PSNAPIS supported by ICR #2574
;
Q
;
GETPGX(PSODFN,PSODRUG) ; called by POST^PSODRG
; input - PSODRUG = array of data from DRUG entry in file 50
; PSODFN = patient identifier DFN
Q:+$G(PSODGCK) ;Not perform PGx OC from Check Interactions hidden action yet. PSODRUG may still hang around from the CK action.
N PSOQUIT,PSORETURN,PSODRARRAY,PSODRUGDA
S PSODRUGDA=$G(PSODRUG("IEN")),PSODRARRAY(PSODRUGDA)="",PSODRARRAY(PSODRUGDA,"DRUGNAME")=$G(PSODRUG("NAME"))
D PGXOC^PSSPGX("PSOPGX",PSODFN,.PSODRARRAY,.PSORETURN,"O") ; call to PDM to request Order Check Results/Warnings
I $D(^TMP($J,"PSSXWARN")) D DISPWARN
K ^TMP($J,"PSSXWARN")
Q
;
DISPWARN ;
N PSOS4,PSOS5,PSOSEV,PSOSOP,DIR,PSOTAG,PRINT,PSOTXT,PSOEFLG
S (PSOS4,PSOS5,PSOSOP,PRINT)=0
; loop through any warnings created
F PSOSEV="ERROR","HIGH","MEDIUM","NONE" S PSOS4=0 F S PSOS4=$O(^TMP($J,"PSSXWARN",PSOSEV,PSOS4)) Q:'PSOS4 D
. W:'+$G(PSOEFLG) @IOF K PSOEFLG
. S PSOS5=0 F S PSOS5=$O(^TMP($J,"PSSXWARN",PSOSEV,PSOS4,PSOS5)) Q:'PSOS5 D
. . I (PSOSEV="ERROR"),'$O(^TMP($J,"PSSXWARN",PSOSEV)) S PSOEFLG=1
. . S PSOTXT=^TMP($J,"PSSXWARN",PSOSEV,PSOS4,PSOS5)
. . I PSOSEV="ERROR" I ($Y+5)>IOSL,(PSOTXT["For more details") D PAUSE(1)
. . I ($Y+4)>IOSL D PAUSE(1)
. . W !,PSOTXT
. I +$O(^TMP($J,"PSSXWARN",PSOSEV,PSOS4)) D PAUSE(1)
. I '$D(^XUSEC("PSORPH",DUZ)),'$P($G(PSOPAR),"^",2),PSOSEV="HIGH" D MESS
. S PRINT=0 I (PSOSEV="MEDIUM")!(PSOSEV="HIGH") S PRINT=$$ASKAI()
. I PRINT D ADDINFO(PSOSEV,PSOS4)
. Q:'$D(^XUSEC("PSORPH",DUZ)) ; need to be a pharmacist to create an intervention
. S PSOTAG=$S(PSOSEV="HIGH":"REQINTERV",PSOSEV="MEDIUM":"OPTINTERV",1:"")
. D:PSOTAG]"" @PSOTAG
D PAUSE(1)
Q
;
OPTINTERV ;Prompt end user for optional intervention
N DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,X
S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="NO"
S DIR("?",1)="Answer 'YES' if you DO want to enter an intervention for this medication,"
S DIR("?")=" 'NO' if you DON'T want to enter an intervention for this medication,"
W ! D ^DIR
; line below: already in the stack - RX ien (PSORXIEN) for VERIFY and REINSTATE actions (PSOZVER and PSOREINO respectively)
I Y D ENPGX^PSORXI("PHARMACOGENOMIC MEDIUM ORDER CHECK",$S($G(PSOZVER):$G(PSORXIEN),$G(PSOREINO):$G(PSORXIEN),1:""))
W !
Q
;
REQINTERV ;Prompt end user for required intervention
N DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,X
W !
S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue? ",DIR("B")="NO"
I $G(PSODRUG("NAME"))]"" S DIR("A")="Do you want to Continue with "_$G(PSODRUG("NAME"))_"? "
S DIR("?",1)="Enter 'NO' if you wish to exit without continuing with the order,",DIR("?")="or 'YES' to continue with the order entry process."
D ^DIR
I 'Y S PSORX("DFLG")=1 ; PSONEW("DFLG") is set when end-user needs to quit processing the order
I Y D
. N X1 D SIG^XUSESIG I X1="" W !!,"Signature Code not valid." S PSORX("DFLG")=1 H 1 Q
. ; line below: already in the stack - RX ien (PSORXIEN) for VERIFY and REINSTATE actions (PSOZVER and PSOREINS respectively)
. D ENPGX^PSORXI("PHARMACOGENOMIC HIGH ORDER CHECK",$S($G(PSOZVER):$G(PSORXIEN),$G(PSOREINS):$G(PSORXIEN),1:"")) ; ; pass in RX ien for VERIFY and REINSTATE actions
Q
;
ASKAI() ; additional information prompt
N DIR,DIRUT,DUOUT,DTOUT,DIROUT
S DIR("A")="Display Additional Information on Pharmacogenomic Order Check(s)"
s DIR("B")="NO",DIR(0)="Y"
S DIR("?",1)="Enter 'YES' to see the additional information on Pharmacogenomic Order Check."
S DIR("?")=" "
D ^DIR K DIR
Q $S(+Y=1:1,1:0)
;
ADDINFO(PSOSEV,PSOS4) ;Display additional information
N ZTDESC,ZTRTN,ZTSAVE
N IOP,%ZIS,POP
S %ZIS="QM"
W ! D ^%ZIS
Q:POP
I $D(IO("Q")) D Q
.S ZTRTN="PRINTAI^PSOOCPGX",ZTDESC="Pharmacogenomic Order Check - Additional Information"
.S ZTSAVE("^TMP($J,""PSSXWARN"",")="",ZTSAVE("PSOSEV")="",ZTSAVE("PSOS4")=""
.D ^%ZTLOAD,^%ZISC
.I $G(ZTSK) W !,"Pharmacogenomic Additional Information Queued, task# ",ZTSK,".",! S:$D(ZTQUEUED) ZTREQ="Q"
D PRINTAI,^%ZISC
Q
;
PRINTAI ;
U IO
I $E(IOST)="C" W @IOF
N PSOX1,DIR,Y,STOP
S (PSOX1,STOP)=0
S PSOX1=0 F S PSOX1=$O(^TMP($J,"PSSXWARN",PSOSEV,PSOS4,"AI",PSOX1)) Q:'PSOX1 Q:STOP D
. W !,^TMP($J,"PSSXWARN",PSOSEV,PSOS4,"AI",PSOX1)
. I $Y+4>IOSL,$E(IOST)="C" D
. . W ! S DIR(0)="EA",DIR("A")="Press Return to continue..."
. . D ^DIR
. . I 'Y S STOP=1 Q
. . W @IOF
Q
;
PAUSE(PSOIOF) ;
W ! S DIR(0)="EA",DIR("A")="Press ENTER to continue ..." D ^DIR W:$G(PSOIOF) @IOF
Q
;
BLD(PSOXDFN,PSOPGXS) ;
N PSOPGXCT,PSOXINDX,X,Y,X1,X2
K ^TMP($J,"ORDERS") I '$G(PSOXDFN) Q
I '$G(DT) S DT=$$DT^XLFDT
I '$G(PSOPGXS) S PSOPGXS=120
S X1=DT,X2=-PSOPGXS D C^%DTC S PSOPGXCT=X D BUILD
Q
BUILD ;build profiles
N PSOPGXEX,PSOPGXRX,PSOEN,PSOEN1,PSOOI,PSODD
S PSOPGXEX=PSOPGXCT-1,PSOPGXRX=0
F S PSOPGXEX=$O(^PS(55,PSOXDFN,"P","A",PSOPGXEX)) Q:'PSOPGXEX F S PSOPGXRX=$O(^PS(55,PSOXDFN,"P","A",PSOPGXEX,PSOPGXRX)) Q:'PSOPGXRX I $D(^PSRX(PSOPGXRX,0)) D GET
S PSOEN1=0
F PSOEN=0:0 S PSOEN=$O(^PS(52.41,"AOR",PSOXDFN,PSOEN)) Q:'PSOEN D
.F S PSOEN1=$O(^PS(52.41,"AOR",PSOXDFN,PSOEN,PSOEN1)) Q:'PSOEN1 D
..Q:'$P(^PS(52.41,PSOEN1,0),"^",8)
..S PSOOI=^PS(52.41,PSOEN1,0)
..I $P(PSOOI,"^",3)'="DC"&($P(PSOOI,"^",3)'="DE") D
...I '$P(^PS(52.41,PSOEN1,0),"^",9) D BLDOI Q
...S PSODD=+$P(PSOOI,"^",9) D SETTMP
Q
;
BLDOI ;If no DD/non-standard dose, get all drugs for OI
N PSOI S PSOI=$P(PSOOI,"^",8) Q:'PSOOI
S PSODD="" F S PSODD=$O(^PSDRUG("ASP",PSOI,PSODD)) Q:'PSODD D SETTMP
Q
;
SETTMP ;Create ^TMP($J,"ORDERS"
N PSOXDRG
Q:$P(PSOOI,"^",3)="RF"
S PSOXDRG=$S(PSODD:$P($G(^PSDRUG(PSODD,0)),"^"),1:"") Q:PSOXDRG']""
S PSOXINDX=$G(PSOXINDX)+1,^TMP($J,"ORDERS",PSOXINDX)=$S(PSODD:$P(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$S($G(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_PSOXDRG_"^"_$P(^PS(52.41,PSOEN1,0),"^")_"^"_PSOEN1_"P;O"
Q
;
GET ;data for profiles
N PSOPGX0,PSOPGX2,PSOPGXST,PSOPGXOR,PSOPGXDG,PSOPGXD0,PSOPGXVC
S PSOPGX0=^PSRX(PSOPGXRX,0),PSOPGXST=+^("STA") Q:(PSOPGXST'=0)&(PSOPGXST'=3)&(PSOPGXST'=5)&(PSOPGXST'=11)&(PSOPGXST'=16)
S PSOPGX2=$G(^PSRX(PSOPGXRX,2)),PSOPGXOR=$P($G(^("OR1")),"^",2)
S PSOPGXDG=+$P(PSOPGX0,"^",6) Q:'$D(^PSDRUG(PSOPGXDG,0))
S PSOPGXD0=^PSDRUG(PSOPGXDG,0),PSOPGXVC=$P(PSOPGXD0,"^",2)
;
I PSOPGXEX<DT,(PSOPGXST<6)!(PSOPGXST=16) D
.N DIE,DIC,DR,DA,PSOGSTAT,PSOGCOMM,PSOPGXDA,PSOPSTAT S PSOGSTAT="SC",DIE=52,DA=PSOPGXRX,DR="100////11" D ^DIE K DIE,DIC,DR,DA
.D ECAN^PSOUTL(PSOPGXRX) S PSOPGXDA=PSOPGXRX
.S PSOGCOMM="Prescription Expired",PSOPSTAT="ZE" D EN^PSOHLSN1(PSOPGXDA,PSOGSTAT,PSOPSTAT,PSOGCOMM)
S PSOXINDX=$G(PSOXINDX)+1
S ^TMP($J,"ORDERS",PSOXINDX)=PSOPGXVC_"^"_$S($G(^PSDRUG(PSOPGXDG,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0)_"^"_$P(^PSDRUG(PSOPGXDG,0),"^")_"^"_PSOPGXOR_"^"_PSOPGXRX_"R;O"
Q
;
MESS ;display technician message
N DIR,DUOUT,DTOUT,DIRUT,DIROUT,DA,DR,X,Y
W !?3,"WARNING: Unlike other orders with Critical Order Checks, this order will"
W !?3,"not be placed in a Non-Verified status for pharmacist verification after"
W !?3,"you process it. If you are unsure about this order, please stop processing"
W !?3,"by '^'ing out, and consult a pharmacist.",!
K DIR S DIR(0)="E",DIR("A")=" Press Return to continue" D ^DIR K DIR W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOOCPGX 7693 printed Sep 23, 2025@20:08:06 Page 2
PSOOCPGX ;BIR/KML - OUTPATIENT PHARMACY PGx ORDER CHECKS DRIVER ;9/10/14 10:53pm
+1 ;;7.0;OUTPATIENT PHARMACY;**737**;DEC 1997;Build 52
+2 ;
+3 ;External reference to PGXOC^PSSPGX is supported by ICR #7526
+4 ;External reference to $$PROD0^PSNAPIS(P1,P3) supported by ICR #2531
+5 ;External reference to $$PGX^PSNAPIS supported by ICR #2574
+6 ;
+7 QUIT
+8 ;
GETPGX(PSODFN,PSODRUG) ; called by POST^PSODRG
+1 ; input - PSODRUG = array of data from DRUG entry in file 50
+2 ; PSODFN = patient identifier DFN
+3 ;Not perform PGx OC from Check Interactions hidden action yet. PSODRUG may still hang around from the CK action.
if +$GET(PSODGCK)
QUIT
+4 NEW PSOQUIT,PSORETURN,PSODRARRAY,PSODRUGDA
+5 SET PSODRUGDA=$GET(PSODRUG("IEN"))
SET PSODRARRAY(PSODRUGDA)=""
SET PSODRARRAY(PSODRUGDA,"DRUGNAME")=$GET(PSODRUG("NAME"))
+6 ; call to PDM to request Order Check Results/Warnings
DO PGXOC^PSSPGX("PSOPGX",PSODFN,.PSODRARRAY,.PSORETURN,"O")
+7 IF $DATA(^TMP($JOB,"PSSXWARN"))
DO DISPWARN
+8 KILL ^TMP($JOB,"PSSXWARN")
+9 QUIT
+10 ;
DISPWARN ;
+1 NEW PSOS4,PSOS5,PSOSEV,PSOSOP,DIR,PSOTAG,PRINT,PSOTXT,PSOEFLG
+2 SET (PSOS4,PSOS5,PSOSOP,PRINT)=0
+3 ; loop through any warnings created
+4 FOR PSOSEV="ERROR","HIGH","MEDIUM","NONE"
SET PSOS4=0
FOR
SET PSOS4=$ORDER(^TMP($JOB,"PSSXWARN",PSOSEV,PSOS4))
if 'PSOS4
QUIT
Begin DoDot:1
+5 if '+$GET(PSOEFLG)
WRITE @IOF
KILL PSOEFLG
+6 SET PSOS5=0
FOR
SET PSOS5=$ORDER(^TMP($JOB,"PSSXWARN",PSOSEV,PSOS4,PSOS5))
if 'PSOS5
QUIT
Begin DoDot:2
+7 IF (PSOSEV="ERROR")
IF '$ORDER(^TMP($JOB,"PSSXWARN",PSOSEV))
SET PSOEFLG=1
+8 SET PSOTXT=^TMP($JOB,"PSSXWARN",PSOSEV,PSOS4,PSOS5)
+9 IF PSOSEV="ERROR"
IF ($Y+5)>IOSL
IF (PSOTXT["For more details")
DO PAUSE(1)
+10 IF ($Y+4)>IOSL
DO PAUSE(1)
+11 WRITE !,PSOTXT
End DoDot:2
+12 IF +$ORDER(^TMP($JOB,"PSSXWARN",PSOSEV,PSOS4))
DO PAUSE(1)
+13 IF '$DATA(^XUSEC("PSORPH",DUZ))
IF '$PIECE($GET(PSOPAR),"^",2)
IF PSOSEV="HIGH"
DO MESS
+14 SET PRINT=0
IF (PSOSEV="MEDIUM")!(PSOSEV="HIGH")
SET PRINT=$$ASKAI()
+15 IF PRINT
DO ADDINFO(PSOSEV,PSOS4)
+16 ; need to be a pharmacist to create an intervention
if '$DATA(^XUSEC("PSORPH",DUZ))
QUIT
+17 SET PSOTAG=$SELECT(PSOSEV="HIGH":"REQINTERV",PSOSEV="MEDIUM":"OPTINTERV",1:"")
+18 if PSOTAG]""
DO @PSOTAG
End DoDot:1
+19 DO PAUSE(1)
+20 QUIT
+21 ;
OPTINTERV ;Prompt end user for optional intervention
+1 NEW DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,X
+2 SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Intervene? "
SET DIR("B")="NO"
+3 SET DIR("?",1)="Answer 'YES' if you DO want to enter an intervention for this medication,"
+4 SET DIR("?")=" 'NO' if you DON'T want to enter an intervention for this medication,"
+5 WRITE !
DO ^DIR
+6 ; line below: already in the stack - RX ien (PSORXIEN) for VERIFY and REINSTATE actions (PSOZVER and PSOREINO respectively)
+7 IF Y
DO ENPGX^PSORXI("PHARMACOGENOMIC MEDIUM ORDER CHECK",$SELECT($GET(PSOZVER):$GET(PSORXIEN),$GET(PSOREINO):$GET(PSORXIEN),1:""))
+8 WRITE !
+9 QUIT
+10 ;
REQINTERV ;Prompt end user for required intervention
+1 NEW DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,X
+2 WRITE !
+3 SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Continue? "
SET DIR("B")="NO"
+4 IF $GET(PSODRUG("NAME"))]""
SET DIR("A")="Do you want to Continue with "_$GET(PSODRUG("NAME"))_"? "
+5 SET DIR("?",1)="Enter 'NO' if you wish to exit without continuing with the order,"
SET DIR("?")="or 'YES' to continue with the order entry process."
+6 DO ^DIR
+7 ; PSONEW("DFLG") is set when end-user needs to quit processing the order
IF 'Y
SET PSORX("DFLG")=1
+8 IF Y
Begin DoDot:1
+9 NEW X1
DO SIG^XUSESIG
IF X1=""
WRITE !!,"Signature Code not valid."
SET PSORX("DFLG")=1
HANG 1
QUIT
+10 ; line below: already in the stack - RX ien (PSORXIEN) for VERIFY and REINSTATE actions (PSOZVER and PSOREINS respectively)
+11 ; ; pass in RX ien for VERIFY and REINSTATE actions
DO ENPGX^PSORXI("PHARMACOGENOMIC HIGH ORDER CHECK",$SELECT($GET(PSOZVER):$GET(PSORXIEN),$GET(PSOREINS):$GET(PSORXIEN),1:""))
End DoDot:1
+12 QUIT
+13 ;
ASKAI() ; additional information prompt
+1 NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT
+2 SET DIR("A")="Display Additional Information on Pharmacogenomic Order Check(s)"
+3 SET DIR("B")="NO"
SET DIR(0)="Y"
+4 SET DIR("?",1)="Enter 'YES' to see the additional information on Pharmacogenomic Order Check."
+5 SET DIR("?")=" "
+6 DO ^DIR
KILL DIR
+7 QUIT $SELECT(+Y=1:1,1:0)
+8 ;
ADDINFO(PSOSEV,PSOS4) ;Display additional information
+1 NEW ZTDESC,ZTRTN,ZTSAVE
+2 NEW IOP,%ZIS,POP
+3 SET %ZIS="QM"
+4 WRITE !
DO ^%ZIS
+5 if POP
QUIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTRTN="PRINTAI^PSOOCPGX"
SET ZTDESC="Pharmacogenomic Order Check - Additional Information"
+8 SET ZTSAVE("^TMP($J,""PSSXWARN"",")=""
SET ZTSAVE("PSOSEV")=""
SET ZTSAVE("PSOS4")=""
+9 DO ^%ZTLOAD
DO ^%ZISC
+10 IF $GET(ZTSK)
WRITE !,"Pharmacogenomic Additional Information Queued, task# ",ZTSK,".",!
if $DATA(ZTQUEUED)
SET ZTREQ="Q"
End DoDot:1
QUIT
+11 DO PRINTAI
DO ^%ZISC
+12 QUIT
+13 ;
PRINTAI ;
+1 USE IO
+2 IF $EXTRACT(IOST)="C"
WRITE @IOF
+3 NEW PSOX1,DIR,Y,STOP
+4 SET (PSOX1,STOP)=0
+5 SET PSOX1=0
FOR
SET PSOX1=$ORDER(^TMP($JOB,"PSSXWARN",PSOSEV,PSOS4,"AI",PSOX1))
if 'PSOX1
QUIT
if STOP
QUIT
Begin DoDot:1
+6 WRITE !,^TMP($JOB,"PSSXWARN",PSOSEV,PSOS4,"AI",PSOX1)
+7 IF $Y+4>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:2
+8 WRITE !
SET DIR(0)="EA"
SET DIR("A")="Press Return to continue..."
+9 DO ^DIR
+10 IF 'Y
SET STOP=1
QUIT
+11 WRITE @IOF
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
PAUSE(PSOIOF) ;
+1 WRITE !
SET DIR(0)="EA"
SET DIR("A")="Press ENTER to continue ..."
DO ^DIR
if $GET(PSOIOF)
WRITE @IOF
+2 QUIT
+3 ;
BLD(PSOXDFN,PSOPGXS) ;
+1 NEW PSOPGXCT,PSOXINDX,X,Y,X1,X2
+2 KILL ^TMP($JOB,"ORDERS")
IF '$GET(PSOXDFN)
QUIT
+3 IF '$GET(DT)
SET DT=$$DT^XLFDT
+4 IF '$GET(PSOPGXS)
SET PSOPGXS=120
+5 SET X1=DT
SET X2=-PSOPGXS
DO C^%DTC
SET PSOPGXCT=X
DO BUILD
+6 QUIT
BUILD ;build profiles
+1 NEW PSOPGXEX,PSOPGXRX,PSOEN,PSOEN1,PSOOI,PSODD
+2 SET PSOPGXEX=PSOPGXCT-1
SET PSOPGXRX=0
+3 FOR
SET PSOPGXEX=$ORDER(^PS(55,PSOXDFN,"P","A",PSOPGXEX))
if 'PSOPGXEX
QUIT
FOR
SET PSOPGXRX=$ORDER(^PS(55,PSOXDFN,"P","A",PSOPGXEX,PSOPGXRX))
if 'PSOPGXRX
QUIT
IF $DATA(^PSRX(PSOPGXRX,0))
DO GET
+4 SET PSOEN1=0
+5 FOR PSOEN=0:0
SET PSOEN=$ORDER(^PS(52.41,"AOR",PSOXDFN,PSOEN))
if 'PSOEN
QUIT
Begin DoDot:1
+6 FOR
SET PSOEN1=$ORDER(^PS(52.41,"AOR",PSOXDFN,PSOEN,PSOEN1))
if 'PSOEN1
QUIT
Begin DoDot:2
+7 if '$PIECE(^PS(52.41,PSOEN1,0),"^",8)
QUIT
+8 SET PSOOI=^PS(52.41,PSOEN1,0)
+9 IF $PIECE(PSOOI,"^",3)'="DC"&($PIECE(PSOOI,"^",3)'="DE")
Begin DoDot:3
+10 IF '$PIECE(^PS(52.41,PSOEN1,0),"^",9)
DO BLDOI
QUIT
+11 SET PSODD=+$PIECE(PSOOI,"^",9)
DO SETTMP
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
BLDOI ;If no DD/non-standard dose, get all drugs for OI
+1 NEW PSOI
SET PSOI=$PIECE(PSOOI,"^",8)
if 'PSOOI
QUIT
+2 SET PSODD=""
FOR
SET PSODD=$ORDER(^PSDRUG("ASP",PSOI,PSODD))
if 'PSODD
QUIT
DO SETTMP
+3 QUIT
+4 ;
SETTMP ;Create ^TMP($J,"ORDERS"
+1 NEW PSOXDRG
+2 if $PIECE(PSOOI,"^",3)="RF"
QUIT
+3 SET PSOXDRG=$SELECT(PSODD:$PIECE($GET(^PSDRUG(PSODD,0)),"^"),1:"")
if PSOXDRG']""
QUIT
+4 SET PSOXINDX=$GET(PSOXINDX)+1
SET ^TMP($JOB,"ORDERS",PSOXINDX)=$SELECT(PSODD:$PIECE(^PSDRUG(PSODD,0),"^",2),1:"")_"^"_$SELECT($GET(^PSDRUG(PSODD,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)_"^"_PSOXDRG_"^"_$PIECE(^PS(52.41,PSOEN1,0),"^")_"^"_PSOEN1_"P;O"
+5 QUIT
+6 ;
GET ;data for profiles
+1 NEW PSOPGX0,PSOPGX2,PSOPGXST,PSOPGXOR,PSOPGXDG,PSOPGXD0,PSOPGXVC
+2 SET PSOPGX0=^PSRX(PSOPGXRX,0)
SET PSOPGXST=+^("STA")
if (PSOPGXST'=0)&(PSOPGXST'=3)&(PSOPGXST'=5)&(PSOPGXST'=11)&(PSOPGXST'=16)
QUIT
+3 SET PSOPGX2=$GET(^PSRX(PSOPGXRX,2))
SET PSOPGXOR=$PIECE($GET(^("OR1")),"^",2)
+4 SET PSOPGXDG=+$PIECE(PSOPGX0,"^",6)
if '$DATA(^PSDRUG(PSOPGXDG,0))
QUIT
+5 SET PSOPGXD0=^PSDRUG(PSOPGXDG,0)
SET PSOPGXVC=$PIECE(PSOPGXD0,"^",2)
+6 ;
+7 IF PSOPGXEX<DT
IF (PSOPGXST<6)!(PSOPGXST=16)
Begin DoDot:1
+8 NEW DIE,DIC,DR,DA,PSOGSTAT,PSOGCOMM,PSOPGXDA,PSOPSTAT
SET PSOGSTAT="SC"
SET DIE=52
SET DA=PSOPGXRX
SET DR="100////11"
DO ^DIE
KILL DIE,DIC,DR,DA
+9 DO ECAN^PSOUTL(PSOPGXRX)
SET PSOPGXDA=PSOPGXRX
+10 SET PSOGCOMM="Prescription Expired"
SET PSOPSTAT="ZE"
DO EN^PSOHLSN1(PSOPGXDA,PSOGSTAT,PSOPSTAT,PSOGCOMM)
End DoDot:1
+11 SET PSOXINDX=$GET(PSOXINDX)+1
+12 SET ^TMP($JOB,"ORDERS",PSOXINDX)=PSOPGXVC_"^"_$SELECT($GET(^PSDRUG(PSOPGXDG,"ND"))]"":+^("ND")_"A"_$PIECE(^("ND"),"^",3),1:0)_"^"_$PIECE(^PSDRUG(PSOPGXDG,0),"^")_"^"_PSOPGXOR_"^"_PSOPGXRX_"R;O"
+13 QUIT
+14 ;
MESS ;display technician message
+1 NEW DIR,DUOUT,DTOUT,DIRUT,DIROUT,DA,DR,X,Y
+2 WRITE !?3,"WARNING: Unlike other orders with Critical Order Checks, this order will"
+3 WRITE !?3,"not be placed in a Non-Verified status for pharmacist verification after"
+4 WRITE !?3,"you process it. If you are unsure about this order, please stop processing"
+5 WRITE !?3,"by '^'ing out, and consult a pharmacist.",!
+6 KILL DIR
SET DIR(0)="E"
SET DIR("A")=" Press Return to continue"
DO ^DIR
KILL DIR
WRITE !
+7 QUIT
