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