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

PSSPRUTL.m

Go to the documentation of this file. 
  1. PSSPRUTL ;BIR/RTR-Edit IV Solution ;04/19/08
  1.  ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/07;Build 67
  1.  ;
  1.  ;
  1. EDIT ;Edit IV Solution
  1.  N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,PSSEDSDA,PSSEDSXX,PSSEDSZZ,PSSEDSDR,PSSEDSGG,PSSEDSAR,DRUGEDIT
  1.  ;Newing D in next line because FileMan is leaving it defined to a zero node upon option exit
  1.  N %,%DT,D0,I,J,MSG,PSJCLEAR,PSPOINT,PSSIVID,SYNIEN,XX,PSSCROSS,D
  1.  I '$D(^XUSEC("PSJI MGR",DUZ)) W !!!,"Sorry, you need the 'PSJI MGR' key to access this option.",! D MESS Q
  1.  L +^PS(52.7):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
  1.  I '$T W !!!,"Sorry, someone else is editing entries in the IV SOLUTIONS (#52.7) File.",! D MESS Q
  1. EDITM ;
  1.  K X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,%,%DT,D0,I,J,MSG,PSJCLEAR,PSPOINT,PSSIVID,SYNIEN,XX,PSSCROSS,D
  1.  ;Setting DRUGEDIT in next line because cross reference on GENERIC DRUG #1 Field of IV SOLUTION (#52.7) File needs it defined
  1.  K PSSEDSDA,PSSEDSXX,PSSEDSZZ,PSSEDSDR,PSSEDSGG,PSSEDSAR S DRUGEDIT=1
  1.  W ! K DIC,X,DTOUT,DUOUT S DIC="^PS(52.7,",DIC(0)="AEQMZ" D ^DIC K DIC,X I Y<0!($D(DUOUT))!($D(DTOUT)) D UN Q
  1.  S PSSEDSDA=+Y,PSSEDSXX=$P($G(^PS(52.7,PSSEDSDA,0)),"^",11)
  1.  K DIE,DA,DR S DIE="^PS(52.7,",DA=PSSEDSDA,DR=".01;.02;1;D GETD^PSSPRUTL;2;8;17;18" D ^DIE K DIE,DA,DR
  1.  ;Change the Generic Drug could automatically change the Orderable Item of the IV Solution
  1.  ;Now doing what MSF^PSSDFEE does, updating Orderable Items, though cross reference on 52.,7,1 should have already done it
  1.  ;Just as a safeguard, we'll look to update all Orderable Items again, note that PSSEDSZZ and PSSEDSGG should never be different
  1.  S PSSEDSZZ=$P($G(^PS(52.7,PSSEDSDA,0)),"^",11),PSSEDSDR=$P($G(^PS(52.7,PSSEDSDA,0)),"^",2),PSSEDSGG=$P($G(^PSDRUG(+PSSEDSDR,2)),"^")
  1.  I PSSEDSZZ K PSSCROSS D EN^PSSPOIDT(PSSEDSZZ),EN2^PSSHL1(PSSEDSZZ,"MUP")
  1.  I PSSEDSGG,PSSEDSGG'=PSSEDSZZ K PSSCROSS D EN^PSSPOIDT(PSSEDSGG),EN2^PSSHL1(PSSEDSGG,"MUP")
  1.  ;I PSSEDSXX D EN^PSSPOIDT(PSSEDSXX),EN2^PSSHL1(PSSEDSXX,"MUP") S PSSEDSAR(PSSEDSXX)=""
  1.  ;I PSSEDSZZ,'$D(PSSEDSAR(PSSEDSZZ)) D EN^PSSPOIDT(PSSEDSZZ),EN2^PSSHL1(PSSEDSZZ,"MUP") S PSSEDSAR(PSSEDSZZ)=""
  1.  ;I PSSEDSGG,'$D(PSSEDSAR(PSSEDSGG)) D EN^PSSPOIDT(PSSEDSGG),EN2^PSSHL1(PSSEDSGG,"MUP") S PSSEDSAR(PSSEDSGG)=""
  1.  W ! G EDITM
  1.  ;D UN
  1.  Q
  1. UN ;Unlock File
  1.  L -^PS(52.7)
  1.  Q
  1.  ;
  1. GETD ;See if generic drug is inactive in file 50, code cloned from line tag GETD Of routine PSSVIDRG
  1.  I $D(^PSDRUG(X,"I")),^("I"),(DT+1>+^("I")) W $C(7),$C(7),!!,"This drug is inactive and will not be selectable during IV order entry.",! S $P(^PS(52.7,PSSEDSDA,"I"),"^")=$P(^PSDRUG(X,"I"),"^")
  1.  Q
  1.  ;
  1. MESS ;
  1.  W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
  1.  Q