Routine: PSJIPST1

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

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

 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)

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)

DEQORDER ; Convert existing UD and IV orders to new format.

 ; Entries found with no 0 node will be deleted!

 ; THIS IS NO LONGER USED

 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

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,"'."

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJIPST1   4739     printed  Mar 13, 2025@21:12:07                                                                                                                                                                                                    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

PSJIPST1.m