Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOCROC

PSOCROC.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference to ORDERCHK^PXRMORCH supported by DBIA 5531
  1. ;Reference to SIG^XUSESIG supported by DBIA 10050
  1. ;
  1. CK ;CHECK FOR CROCS AGAINST PROSPECTIVE DRUG
  1. S $P(CROCLN,"=",60)="=",$P(CROCLN2,"-",60)="-"
  1. I CROCPFLG&(($Y+4)>IOSL) D WAIT^PSODRG W ! K CROCPFLG
  1. D ORDERCHK^PXRMORCH(DFN,-1,0,$G(PSODRUG("IEN")),0)
  1. I '$D(VADM) D DEM^VADPT ;restore VA & VADM array variable after calling CROC by *569
  1. I '$D(^TMP($J,$G(PSODRUG("IEN")))) W !,"Now processing Clinical Reminder Order Checks. Please wait ..."
  1. N PSOFIRST
  1. I $D(^TMP($J,$G(PSODRUG("IEN")))) D
  1. . W !,"Now processing Clinical Reminder Order Checks. Please wait ..."
  1. S (CROCSTA,CROCDNM,CROCNUM,CROCSTR,CROCHFLG)=""
  1. I $D(^TMP($J,$G(PSODRUG("IEN")))) D
  1. .S CROCHFLG=2
  1. .F S CROCSTA=$O(^TMP($J,PSODRUG("IEN"),CROCSTA)) Q:CROCSTA=""!$G(PSORX("DFLG")) D
  1. ..I CROCSTA=1 S CROCHFLG=1
  1. ..F S CROCDNM=$O(^TMP($J,PSODRUG("IEN"),CROCSTA,CROCDNM)) Q:CROCDNM=""!$G(PSORX("DFLG")) D
  1. ...I '$G(PSOFIRST) W !!,CROCLN S PSOFIRST=1
  1. ...S CROCSTA2=$S(CROCSTA=1:"HIGH",CROCSTA=2:"MEDIUM",CROCSTA=3:"LOW",1:"UNKNOWN")
  1. ...W !,"*** Clinical Reminder Order Check | Severity: "_CROCSTA2_" ***",!
  1. ...W !,CROCDNM,!
  1. ...F S CROCNUM=$O(^TMP($J,PSODRUG("IEN"),CROCSTA,CROCDNM,CROCNUM)) Q:CROCNUM=""!$G(PSORX("DFLG")) D
  1. ....I ($Y+7)>IOSL,$E(IOST)="C" D
  1. .....W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF
  1. ....W !,^TMP($J,PSODRUG("IEN"),CROCSTA,CROCDNM,CROCNUM)
  1. ...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
  1. I $G(PSODGCK) G KILL
  1. I CROCHFLG=1 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue? ",DIR("B")="Y" D ^DIR
  1. I CROCHFLG=1,Y["^"!(Y=0)!($D(DIRUT)) S (PSORX("DFLG"))=1 G KILL
  1. I CROCHFLG=1 D SIG^XUSESIG I X1="" W !!,"Signature Code not valid" S (PSORX("DFLG"))=1 H 2 G KILL
  1. I CROCHFLG=1 I X1'="" D EN3^PSORXI("CLINICAL REMINDER")
  1. I CROCHFLG=2 W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="N" D ^DIR
  1. I CROCHFLG=2,Y=1 D EN3^PSORXI("CLINICAL REMINDER")
  1. KILL K CROCSTA,CROCSTA2,CROCDNM,CROCNUM,CROCSTR,CROCHFLG,CROCLN,CROCLN2,X1,Y,DIRUT
  1. Q
  1. ;
  1. ADDCR ;Add CLINICAL REMINDER (one time use as post install)
  1. I '$$FIND1^DIC(9009032.3,"","X","CLINICAL REMINDER","B") D
  1. .N PSSMRMPD K PSSMRMER S PSSMRMPD(1,9009032.3,"+1,",.01)="CLINICAL REMINDER" D UPDATE^DIE("","PSSMRMPD(1)",,"PSSMRMER(1)")
  1. K PSSMRMPD,PSSMRMER
  1. Q