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

PSJIPST.m

Go to the documentation of this file. 
  1. PSJIPST ;BIR/CML3-POST INIT DRIVER ;11 DEC 97 / 3:11 PM 
  1.  ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
  1.  ;
  1.  D MES^XPDUTL(" ")
  1.  S PSJIPSTF=1 D NOW^%DTC D YX^%DTC S PSJMESSG="POST-INIT STARTED AT "_Y_" ...." D MES^XPDUTL(PSJMESSG)
  1.  ;
  1.  ;Set flags and skip conversions if virgin install.
  1.  I $D(PSGINITF) D
  1.  .D NOW^%DTC S ^PS(59.7,1,20.5)=%_"^"_%_"^"_%_"^"_% D:XPDQUES("POS1")=1 VIRGIN
  1.  D ^PSJIPSTA
  1.  ;
  1.  ; Connect movement event driver
  1.  D:'$P($G(^PS(59.7,1,20.5)),U,2) START^PSJIPST1
  1.  ;
  1.  ; Do Unit Dose Order Sets conversion
  1.  D:'$P($G(^PS(59.7,1,20.5)),U,4) 111^PSJIPST3
  1.  ;
  1. UPF ; update package file, if necessary .... took this code out
  1. DONE ;
  1.  F X="AUDDD","AUDAPM","ALCNVRT" S ^PS(55,X)=+$P($T(PSJIPST+1),";",3)
  1.  ;
  1.  ; Queue 5.0 order conversion.
  1.  ; called from OERR now
  1.  ;D:('$P($G(^PS(59.7,1,20.5)),U,2))&('$D(PSGINITF)) ENORDER^PSJIPST1,ENIVKV^PSGSETU
  1.  ;
  1.  ; Queue 5.0 pick list conversion.
  1.  D:'$P($G(^PS(59.7,1,20.5)),U,3) ENPL^PSJIPST1
  1.  ; Queue 5.0 Unit Dose Verification conversion.
  1.  D:'$P($G(^PS(59.7,1,20.5)),U) ENPVNV^PSJIPST2
  1.  D SNMM,ENUPO
  1.  D MES^XPDUTL(" ")
  1.  D NOW^%DTC S $P(^PS(59.7,1,20),"^",1,3)=+$P($T(PSJIPST+1),";",3)_"^"_%_"^"_DUZ,Y=% D YX^%DTC S PSJMESSG="POST-INSTALL COMPLETED AT "_Y_" ...." D MES^XPDUTL(PSJMESSG)
  1.  ; fill in ^XTMP zero nodes
  1.  N PSJDATE1,PSJDATE2
  1.  D NOW^%DTC S PSJDATE1=X,X1=X,X2=7 D C^%DTC S PSJDATE2=X
  1.  S ^XTMP("PSJ NEW PERSON",0)=PSJDATE2_"^"_PSJDATE1_"^"_"List of changed User Names in IV orders"
  1.  Q
  1.  ;
  1. VIRGIN ; Queue process to mark all drugs as UD items (Virgin install only).
  1.  K ZTSAVE,ZTSK S ZTRTN="ENMUD^PSJIPST1",ZTDTH=$H,ZTDESC="MARK ALL DISPENSE DRUGS AS UNIT DOSE ITEMS (INPATIENT MEDS POST-INSTALL)",ZTIO="" D ^%ZTLOAD
  1.  S PSJMESSG="... the process to mark all ACTIVE drugs in your local drug file as Unit Dose items is"_$S($D(ZTSK):"",1:"NOT")_" queued." D MES^XPDUTL(PSJMESSG)
  1.  I $D(ZTSK) D MES^XPDUTL(" (to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN THE TASK HAS COMPLETED.")
  1.  Q
  1.  ;
  1. SNMM ;
  1.  N PSG,XMY S XMSUB="INPATIENT MEDICATIONS "_$P($T(PSJIPST+1),";",3)_" INSTALL COMPLETED",XMY("MIMS,M@DOMAIN.NAME")="",XMDUZ=DUZ,XMTEXT="PSG(",%H=$H D YX^%DTC
  1.  S PSG(1,0)=" "
  1.  S PSG(2,0)="  "_$P($$SITE^VASITE(),"^",2)_" HAS RUN THE INPATIENT MEDICATION V"_$P($T(PSJIPST+1),";",3)_" INSTALL"
  1.  S PSG(3,0)="TO COMPLETION AS OF "_Y_"."
  1.  N DIFROM D ^XMD K SITE Q
  1.  ;
  1. ENUPO ; update options when conversions done
  1.  ;  get list of Pick List options IENs, these will not be enabled until
  1.  ;  the end of the pick list conversion
  1.  S PSJOPLIS="|"_+$O(^DIC(19,"B","PSJU PLDEL",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLAPS",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLPRG",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLDP",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU EUD",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PL",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU RET",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLRP",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLATCS",0))_"|"
  1.  S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLUP",0))_"|"
  1.  D MES^XPDUTL("...removing the 'OUT OF ORDER' message from the Inpatient Medications options...")
  1.  S Q1="PSJ" F  S Q1=$O(^DIC(19,"B",Q1)) Q:$E(Q1,1,3)'="PSJ"  F Q2=0:0 S Q2=$O(^DIC(19,"B",Q1,Q2)) Q:'Q2  D
  1.  .S DIE="^DIC(19,",DA=Q2,DR="2///@" D:PSJOPLIS'[("|"_Q2_"|") ^DIE
  1.  D MES^XPDUTL("...removing the 'DISABLE' message from the Inpatient Medications protocols...")
  1.  S Q1="PSJ" F  S Q1=$O(^ORD(101,"B",Q1)) Q:$E(Q1,1,3)'="PSJ"  F Q2=0:0 S Q2=$O(^ORD(101,"B",Q1,Q2)) Q:'Q2  S DIE="^ORD(101,",DA=Q2,DR="2///@" D ^DIE
  1.  ; if package is reinstalled and Pick list conversion has finished
  1.  ; the options will be reactivated again
  1.  D:$P($G(^PS(59.7,1,20.5)),U,3) ACTPK^PSJIPST2
  1.  D PURG
  1.  K DA,DIE,DR,PSJOPLIS,Q1,Q2,X,Y
  1.  Q
  1. PURG ; Place PURGE options as OUT OF ORDER     
  1.  ; take this out later!!!!!!!  keeps users from using the purge options
  1.  N NAME,IEN
  1.  F NAME="PSJU PO PURGE","PSJI PURGE","PSJI PURGE ORDERS" S IEN=$O(^DIC(19,"B",NAME,0)) S DIE="^DIC(19,",DA=IEN,DR="2////TEMPORARILY UNAVAILABLE" D ^DIE K DIE
  1.  Q