PSJIPST1 ;BIR/CML3-INSTALL INPATIENT MEDS FOR OE/RR (& MAS) ;03 OCT 96 / 8:42 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
START ;
;W !!,"...installing Inpatient Medications protocols for OE/RR (and MAS)..." D ^PSJONIT
;W !!,"...setting up Inpatient protocols..."
S MENU="DGPM MOVEMENT EVENTS",ITEM="PSJ OR PAT ADT" D SETUP,DONE
;W !!,"...installing Inpatient Medications List Templates..." D ^PSJL
Q
;
ENORDER ; Begin conversion of existing orders (active after t-365)
; THIS IS NO LONGER CALLED FROM OUR POST INIT
; THIS CONVERSION IS RAN THROUGH CPRS
Q
K ZTSAVE,ZTSK S ZTRTN="DEQORDER^PSJIPST1",ZTDTH=$H,ZTDESC="Inpatient Orders Conversion (INPATIENT MEDS POST-INIT)",ZTIO="" D ^%ZTLOAD
;W !!,"The conversion of existing Unit Dose orders to the new format is",$S($D(ZTSK):"",1:" NOT")," queued",!
D MES^XPDUTL(" ")
S PSJMESSG="The conversion of existing Unit Dose orders to the new format is"_$S($D(ZTSK):"",1:" NOT")_" queued" D MES^XPDUTL(PSJMESSG)
;I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
I $D(ZTSK) S PSJMESSG="(to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED." D MES^XPDUTL(PSJMESSG)
Q
;
ENPL ; Entry point to begin conversion process to change pick list
; from primary drug to orderable item.
;
K ZTSAVE,ZTSK S ZTIO="",ZTDTH=$H,ZTDESC="Conversion of Pick Lists",ZTRTN="DEQPL^PSJIPST2" D ^%ZTLOAD
;W !!,"The conversion of existing pick lists from primary drug to orderable item",!,"has",$S($D(ZTSK):"",1:" NOT")," been queued"
D MES^XPDUTL(" ")
S PSJMESSG="The conversion of existing pick lists from primary drug to orderable item has"_$S($D(ZTSK):"",1:" NOT")_" been queued" D MES^XPDUTL(PSJMESSG)
;I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
I $D(ZTSK) S PSJMESSG=" (to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED." D MES^XPDUTL(PSJMESSG)
Q
;
DEQORDER ; Convert existing UD and IV orders to new format.
; Entries found with no 0 node will be deleted!
; THIS IS NO LONGER USED
Q
D NOW^%DTC S PSJSTART=$E(%,1,12),PCNT=0
F DFN=0:0 S DFN=$O(^PS(55,DFN)) Q:'DFN D CONVERT^PSJUTL1(DFN,0) S PCNT=PCNT+1
D BADNAMES^PSJIPST3 ; sends mail message if changed names were found
;
; Send mail message when Inpatient order conversion completes.
K PSG,XMY S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="INPATIENT MEDS ORDER CONVERSION COMPLETED",XMTEXT="PSG(",XMY(DUZ)="" D NOW^%DTC S Y=% X ^DD("DD")
S PSG(1,0)=" The conversion of existing Unit Dose orders for use with Inpatient",PSG(2,0)="Medications 5.0 completed as of "_Y_"."
S X=$$FMDIFF^XLFDT(%,PSJSTART,3) S:$L(X," ")>1 DAYS=+$P(X," "),X=$P(X," ",2) S HOURS=+$P(X,":"),MINS=+$P(X,":",2)
S PSG(3,0)=" ",PSG(4,0)="This process converted orders for "_PCNT_" patients in "_$S($G(DAYS):DAYS_" day"_$E("s",DAYS'=1)_", ",1:"")_HOURS_" hour"_$E("s",HOURS'=1),PSG(5,0)=" and "_MINS_" minute"_$E("s",MINS'=1)_"."
N DIFROM D ^XMD
;
DONE ;
K DA,DFN,DIC,DIE,DIK,DINUM,DLAYGO,DR,ITEM,MENU,ON,PSG,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK
Q
UNDO ; FOR DIAGNOSTIC DEVELOPMENT ONLY!!!
F DFN=0:0 S DFN=$O(^PS(55,DFN)) Q:'DFN S $P(^PS(55,DFN,5.1),U,11)="" D
.F ON=0:0 S ON=$O(^PS(55,DFN,5,ON)) Q:'ON K ^PS(55,DFN,5,ON,.2)
.F ON=0:0 S ON=$O(^PS(55,DFN,"IV",ON)) Q:ON K ^PS(55,DFN,"IV",ON,.2)
;
SETUP ;
S MENUP=$O(^ORD(101,"B",MENU,0)) I 'MENUP W $C(7),!!,"Cannot find the protocol menu '",MENU,"'.",!,"You need to add the protocol '",ITEM,"' to this protocol menu.",! Q
;
SETUP1 ;
S X=$O(^ORD(101,"B",ITEM,0)) I 'X W $C(7),!!,"Cannot find the protocol '",ITEM,"'.",!,"You need to add this protocol to the protocol menu '",MENU,"'.",! Q
I $D(^ORD(101,MENUP,10,"B",X)) W !,"Protocol '",ITEM,"' is already set up under the protocol",!,"menu '",MENU,"'." Q
I $D(^ORD(101,MENUP,10,0))[0 S ^ORD(101,MENUP,10,0)="^"_$P(^DD(101,10,0),"^",2)
K DA,DD,DO,DIC S DIC="^ORD(101,"_MENUP_",10,",DIC(0)="L",DLAYGO=101.01,DA(1)=MENUP D FILE^DICN
W !,"Protocol '",ITEM,"' ",$S($P(Y,"^",3):"",1:"NOT "),"added to the protocol menu",!,"'",MENU,"'."
Q
;
ENMUD ; Mark ALL 50 drugs as UD items.
S PSIUX="U" F DRG=0:0 S DRG=$O(^PSDRUG(DRG)) Q:'DRG I $S('$D(^PSDRUG(DRG,"I")):1,'+^("I"):1,+^("I")>DT:1,1:0) S PSIUDA=+DRG D ENS^PSGIU
MAILMUD ;
N DRG,APU,PSJ,XMY D NOW^%DTC S Y=% X ^DD("DD") S XMDUZ="MEDICATIONS,INPATIENT",XMSUB="MARK ALL DRUGS AS UNIT DOSE ITEMS",XMTEXT="PSJ(",XMY(DUZ)=""
S PSJ(1,0)=" The process to mark all ACTIVE drugs in your local drug file (50) as Unit",PSJ(2,0)="Dose items completed as of "_$P(Y,"@")_" "_$P(Y,"@",2)_"."
N DIFROM D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJIPST1 4739 printed Apr 09, 2024@21:05:56 Page 2
PSJIPST1 ;BIR/CML3-INSTALL INPATIENT MEDS FOR OE/RR (& MAS) ;03 OCT 96 / 8:42 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
START ;
+1 ;W !!,"...installing Inpatient Medications protocols for OE/RR (and MAS)..." D ^PSJONIT
+2 ;W !!,"...setting up Inpatient protocols..."
+3 SET MENU="DGPM MOVEMENT EVENTS"
SET ITEM="PSJ OR PAT ADT"
DO SETUP
DO DONE
+4 ;W !!,"...installing Inpatient Medications List Templates..." D ^PSJL
+5 QUIT
+6 ;
ENORDER ; Begin conversion of existing orders (active after t-365)
+1 ; THIS IS NO LONGER CALLED FROM OUR POST INIT
+2 ; THIS CONVERSION IS RAN THROUGH CPRS
+3 QUIT
+4 KILL ZTSAVE,ZTSK
SET ZTRTN="DEQORDER^PSJIPST1"
SET ZTDTH=$HOROLOG
SET ZTDESC="Inpatient Orders Conversion (INPATIENT MEDS POST-INIT)"
SET ZTIO=""
DO ^%ZTLOAD
+5 ;W !!,"The conversion of existing Unit Dose orders to the new format is",$S($D(ZTSK):"",1:" NOT")," queued",!
+6 DO MES^XPDUTL(" ")
+7 SET PSJMESSG="The conversion of existing Unit Dose orders to the new format is"_$SELECT($DATA(ZTSK):"",1:" NOT")_" queued"
DO MES^XPDUTL(PSJMESSG)
+8 ;I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
+9 IF $DATA(ZTSK)
SET PSJMESSG="(to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
DO MES^XPDUTL(PSJMESSG)
+10 QUIT
+11 ;
ENPL ; Entry point to begin conversion process to change pick list
+1 ; from primary drug to orderable item.
+2 ;
+3 KILL ZTSAVE,ZTSK
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="Conversion of Pick Lists"
SET ZTRTN="DEQPL^PSJIPST2"
DO ^%ZTLOAD
+4 ;W !!,"The conversion of existing pick lists from primary drug to orderable item",!,"has",$S($D(ZTSK):"",1:" NOT")," been queued"
+5 DO MES^XPDUTL(" ")
+6 SET PSJMESSG="The conversion of existing pick lists from primary drug to orderable item has"_$SELECT($DATA(ZTSK):"",1:" NOT")_" been queued"
DO MES^XPDUTL(PSJMESSG)
+7 ;I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
+8 IF $DATA(ZTSK)
SET PSJMESSG=" (to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
DO MES^XPDUTL(PSJMESSG)
+9 QUIT
+10 ;
DEQORDER ; Convert existing UD and IV orders to new format.
+1 ; Entries found with no 0 node will be deleted!
+2 ; THIS IS NO LONGER USED
+3 QUIT
+4 DO NOW^%DTC
SET PSJSTART=$EXTRACT(%,1,12)
SET PCNT=0
+5 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,DFN))
if 'DFN
QUIT
DO CONVERT^PSJUTL1(DFN,0)
SET PCNT=PCNT+1
+6 ; sends mail message if changed names were found
DO BADNAMES^PSJIPST3
+7 ;
+8 ; Send mail message when Inpatient order conversion completes.
+9 KILL PSG,XMY
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="INPATIENT MEDS ORDER CONVERSION COMPLETED"
SET XMTEXT="PSG("
SET XMY(DUZ)=""
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+10 SET PSG(1,0)=" The conversion of existing Unit Dose orders for use with Inpatient"
SET PSG(2,0)="Medications 5.0 completed as of "_Y_"."
+11 SET X=$$FMDIFF^XLFDT(%,PSJSTART,3)
if $LENGTH(X," ")>1
SET DAYS=+$PIECE(X," ")
SET X=$PIECE(X," ",2)
SET HOURS=+$PIECE(X,":")
SET MINS=+$PIECE(X,":",2)
+12 SET PSG(3,0)=" "
SET PSG(4,0)="This process converted orders for "_PCNT_" patients in "_$SELECT($GET(DAYS):DAYS_" day"_$EXTRACT("s",DAYS'=1)_", ",1:"")_HOURS_" hour"_$EXTRACT("s",HOURS'=1)
SET PSG(5,0)=" and "_MINS_" minute"_$EXTRACT("s",MINS'=1)_"."
+13 NEW DIFROM
DO ^XMD
+14 ;
DONE ;
+1 KILL DA,DFN,DIC,DIE,DIK,DINUM,DLAYGO,DR,ITEM,MENU,ON,PSG,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTDESC,ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSK
+2 QUIT
UNDO ; FOR DIAGNOSTIC DEVELOPMENT ONLY!!!
+1 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,DFN))
if 'DFN
QUIT
SET $PIECE(^PS(55,DFN,5.1),U,11)=""
Begin DoDot:1
+2 FOR ON=0:0
SET ON=$ORDER(^PS(55,DFN,5,ON))
if 'ON
QUIT
KILL ^PS(55,DFN,5,ON,.2)
+3 FOR ON=0:0
SET ON=$ORDER(^PS(55,DFN,"IV",ON))
if ON
QUIT
KILL ^PS(55,DFN,"IV",ON,.2)
End DoDot:1
+4 ;
SETUP ;
+1 SET MENUP=$ORDER(^ORD(101,"B",MENU,0))
IF 'MENUP
WRITE $CHAR(7),!!,"Cannot find the protocol menu '",MENU,"'.",!,"You need to add the protocol '",ITEM,"' to this protocol menu.",!
QUIT
+2 ;
SETUP1 ;
+1 SET X=$ORDER(^ORD(101,"B",ITEM,0))
IF 'X
WRITE $CHAR(7),!!,"Cannot find the protocol '",ITEM,"'.",!,"You need to add this protocol to the protocol menu '",MENU,"'.",!
QUIT
+2 IF $DATA(^ORD(101,MENUP,10,"B",X))
WRITE !,"Protocol '",ITEM,"' is already set up under the protocol",!,"menu '",MENU,"'."
QUIT
+3 IF $DATA(^ORD(101,MENUP,10,0))[0
SET ^ORD(101,MENUP,10,0)="^"_$PIECE(^DD(101,10,0),"^",2)
+4 KILL DA,DD,DO,DIC
SET DIC="^ORD(101,"_MENUP_",10,"
SET DIC(0)="L"
SET DLAYGO=101.01
SET DA(1)=MENUP
DO FILE^DICN
+5 WRITE !,"Protocol '",ITEM,"' ",$SELECT($PIECE(Y,"^",3):"",1:"NOT "),"added to the protocol menu",!,"'",MENU,"'."
+6 QUIT
+7 ;
ENMUD ; Mark ALL 50 drugs as UD items.
+1 SET PSIUX="U"
FOR DRG=0:0
SET DRG=$ORDER(^PSDRUG(DRG))
if 'DRG
QUIT
IF $SELECT('$DATA(^PSDRUG(DRG,"I")):1,'+^("I"):1,+^("I")>DT:1,1:0)
SET PSIUDA=+DRG
DO ENS^PSGIU
MAILMUD ;
+1 NEW DRG,APU,PSJ,XMY
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET XMDUZ="MEDICATIONS,INPATIENT"
SET XMSUB="MARK ALL DRUGS AS UNIT DOSE ITEMS"
SET XMTEXT="PSJ("
SET XMY(DUZ)=""
+2 SET PSJ(1,0)=" The process to mark all ACTIVE drugs in your local drug file (50) as Unit"
SET PSJ(2,0)="Dose items completed as of "_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)_"."
+3 NEW DIFROM
DO ^XMD
+4 QUIT
