PSOCROC ;HP/MJE - CLINICAL REMINDER ORDER CHECK FOR OP ORDER CHECKS ;09/22/11 5:00pm
;;7.0;OUTPATIENT PHARMACY;**411,569**;DEC 1997;Build 1
;
;Reference to ORDERCHK^PXRMORCH supported by DBIA 5531
;Reference to SIG^XUSESIG supported by DBIA 10050
;
CK ;CHECK FOR CROCS AGAINST PROSPECTIVE DRUG
S $P(CROCLN,"=",60)="=",$P(CROCLN2,"-",60)="-"
I CROCPFLG&(($Y+4)>IOSL) D WAIT^PSODRG W ! K CROCPFLG
D ORDERCHK^PXRMORCH(DFN,-1,0,$G(PSODRUG("IEN")),0)
I '$D(VADM) D DEM^VADPT ;restore VA & VADM array variable after calling CROC by *569
I '$D(^TMP($J,$G(PSODRUG("IEN")))) W !,"Now processing Clinical Reminder Order Checks. Please wait ..."
N PSOFIRST
I $D(^TMP($J,$G(PSODRUG("IEN")))) D
. W !,"Now processing Clinical Reminder Order Checks. Please wait ..."
S (CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG)=""
I $D(^TMP($J,$G(PSODRUG("IEN")))) D
.S CROCHFLG=2
.F S CROCSTA=$O(^TMP($J,PSODRUG("IEN"),CROCSTA)) Q:CROCSTA=""!$G(PSORX("DFLG")) D
..I CROCSTA=1 S CROCHFLG=1
..F S CROCDNM=$O(^TMP($J,PSODRUG("IEN"),CROCSTA,CROCDNM)) Q:CROCDNM=""!$G(PSORX("DFLG")) D
...I '$G(PSOFIRST) W !!,CROCLN S PSOFIRST=1
...S CROCSTA2=$S(CROCSTA=1:"HIGH",CROCSTA=2:"MEDIUM",CROCSTA=3:"LOW",1:"UNKNOWN")
...W !,"*** Clinical Reminder Order Check | Severity: "_CROCSTA2_" ***",!
...W !,CROCDNM,!
...F S CROCNUM=$O(^TMP($J,PSODRUG("IEN"),CROCSTA,CROCDNM,CROCNUM)) Q:CROCNUM=""!$G(PSORX("DFLG")) D
....I ($Y+7)>IOSL,$E(IOST)="C" D
.....W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
....W !,^TMP($J,PSODRUG("IEN"),CROCSTA,CROCDNM,CROCNUM)
...W !!,CROCLN2 I ($Y+5)>IOSL W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
I $G(PSODGCK) G KILL
I CROCHFLG=1 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue? ",DIR("B")="Y" D ^DIR
I CROCHFLG=1,Y["^"!(Y=0)!($D(DIRUT)) S (PSORX("DFLG"))=1 G KILL
I CROCHFLG=1 D SIG^XUSESIG I X1="" W !!,"Signature Code not valid" S (PSORX("DFLG"))=1 H 2 G KILL
I CROCHFLG=1 I X1'="" D EN3^PSORXI("CLINICAL REMINDER")
I CROCHFLG=2 W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="N" D ^DIR
I CROCHFLG=2,Y=1 D EN3^PSORXI("CLINICAL REMINDER")
KILL K CROCSTA,CROCSTA2,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,X1,Y,DIRUT
Q
;
ADDCR ;Add CLINICAL REMINDER (one time use as post install)
I '$$FIND1^DIC(9009032.3,"","X","CLINICAL REMINDER","B") D
.N PSSMRMPD K PSSMRMER S PSSMRMPD(1,9009032.3,"+1,",.01)="CLINICAL REMINDER" D UPDATE^DIE("","PSSMRMPD(1)",,"PSSMRMER(1)")
K PSSMRMPD,PSSMRMER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCROC 2584 printed Apr 09, 2024@21:26:34 Page 2
PSOCROC ;HP/MJE - CLINICAL REMINDER ORDER CHECK FOR OP ORDER CHECKS ;09/22/11 5:00pm
+1 ;;7.0;OUTPATIENT PHARMACY;**411,569**;DEC 1997;Build 1
+2 ;
+3 ;Reference to ORDERCHK^PXRMORCH supported by DBIA 5531
+4 ;Reference to SIG^XUSESIG supported by DBIA 10050
+5 ;
CK ;CHECK FOR CROCS AGAINST PROSPECTIVE DRUG
+1 SET $PIECE(CROCLN,"=",60)="="
SET $PIECE(CROCLN2,"-",60)="-"
+2 IF CROCPFLG&(($Y+4)>IOSL)
DO WAIT^PSODRG
WRITE !
KILL CROCPFLG
+3 DO ORDERCHK^PXRMORCH(DFN,-1,0,$GET(PSODRUG("IEN")),0)
+4 ;restore VA & VADM array variable after calling CROC by *569
IF '$DATA(VADM)
DO DEM^VADPT
+5 IF '$DATA(^TMP($JOB,$GET(PSODRUG("IEN"))))
WRITE !,"Now processing Clinical Reminder Order Checks. Please wait ..."
+6 NEW PSOFIRST
+7 IF $DATA(^TMP($JOB,$GET(PSODRUG("IEN"))))
Begin DoDot:1
+8 WRITE !,"Now processing Clinical Reminder Order Checks. Please wait ..."
End DoDot:1
+9 SET (CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG)=""
+10 IF $DATA(^TMP($JOB,$GET(PSODRUG("IEN"))))
Begin DoDot:1
+11 SET CROCHFLG=2
+12 FOR
SET CROCSTA=$ORDER(^TMP($JOB,PSODRUG("IEN"),CROCSTA))
if CROCSTA=""!$GET(PSORX("DFLG"))
QUIT
Begin DoDot:2
+13 IF CROCSTA=1
SET CROCHFLG=1
+14 FOR
SET CROCDNM=$ORDER(^TMP($JOB,PSODRUG("IEN"),CROCSTA,CROCDNM))
if CROCDNM=""!$GET(PSORX("DFLG"))
QUIT
Begin DoDot:3
+15 IF '$GET(PSOFIRST)
WRITE !!,CROCLN
SET PSOFIRST=1
+16 SET CROCSTA2=$SELECT(CROCSTA=1:"HIGH",CROCSTA=2:"MEDIUM",CROCSTA=3:"LOW",1:"UNKNOWN")
+17 WRITE !,"*** Clinical Reminder Order Check | Severity: "_CROCSTA2_" ***",!
+18 WRITE !,CROCDNM,!
+19 FOR
SET CROCNUM=$ORDER(^TMP($JOB,PSODRUG("IEN"),CROCSTA,CROCDNM,CROCNUM))
if CROCNUM=""!$GET(PSORX("DFLG"))
QUIT
Begin DoDot:4
+20 IF ($Y+7)>IOSL
IF $EXTRACT(IOST)="C"
Begin DoDot:5
+21 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:5
+22 WRITE !,^TMP($JOB,PSODRUG("IEN"),CROCSTA,CROCDNM,CROCNUM)
End DoDot:4
+23 WRITE !!,CROCLN2
IF ($Y+5)>IOSL
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue..."
DO ^DIR
KILL DIR
WRITE @IOF
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF $GET(PSODGCK)
GOTO KILL
+25 IF CROCHFLG=1
SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Continue? "
SET DIR("B")="Y"
DO ^DIR
+26 IF CROCHFLG=1
IF Y["^"!(Y=0)!($DATA(DIRUT))
SET (PSORX("DFLG"))=1
GOTO KILL
+27 IF CROCHFLG=1
DO SIG^XUSESIG
IF X1=""
WRITE !!,"Signature Code not valid"
SET (PSORX("DFLG"))=1
HANG 2
GOTO KILL
+28 IF CROCHFLG=1
IF X1'=""
DO EN3^PSORXI("CLINICAL REMINDER")
+29 IF CROCHFLG=2
WRITE !
SET DIR(0)="SA^1:YES;0:NO"
SET DIR("A")="Do you want to Intervene? "
SET DIR("B")="N"
DO ^DIR
+30 IF CROCHFLG=2
IF Y=1
DO EN3^PSORXI("CLINICAL REMINDER")
KILL KILL CROCSTA,CROCSTA2,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,X1,Y,DIRUT
+1 QUIT
+2 ;
ADDCR ;Add CLINICAL REMINDER (one time use as post install)
+1 IF '$$FIND1^DIC(9009032.3,"","X","CLINICAL REMINDER","B")
Begin DoDot:1
+2 NEW PSSMRMPD
KILL PSSMRMER
SET PSSMRMPD(1,9009032.3,"+1,",.01)="CLINICAL REMINDER"
DO UPDATE^DIE("","PSSMRMPD(1)",,"PSSMRMER(1)")
End DoDot:1
+3 KILL PSSMRMPD,PSSMRMER
+4 QUIT
