PSJQPR.m

PSJQPR ;BIR/MLM-INPATIENT MEDS/IV FLUIDS QUICK ORDERS REPORT ;29 SEP 94 / 9:13 AM

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 ;

EN ; Entry point to enter/edit Inpatient Pharmacy quick orders/protocols.

 W:$Y @IOF W !,"  This lists Inpatient Medication and/or IV Fluid Quick Orders that have been",!

 W "defined in the Pharmacy Quick Orders file. You may list only IV Fluid quick",!,"orders, only Inpatient Medication quick orders, or all quick orders."

 K DIR S DIR(0)="SO^F:IV Fluids;M:Inpatient Medications;A:All",DIR("B")="All",DIR("??")="^D HLP^PSJQPR" D ^DIR Q:$D(DIRUT)  S P("TYP")=$S(Y="F":1,Y="M":2,1:3)

 ;

ENQ ; Ask device and queue report.

 W ! K IO("Q"),%ZIS,IOP S %ZIS="QM" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED" G K

 G:'$D(IO("Q")) DEQ K ZTDTH,ZTSAVE,ZTSK S ZTIO=ION,ZTSAVE("P(")="",ZTRTN="DEQ^PSJQPR",ZTDESC="IV FLUIDS QUICK ORDERS REPORT" K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Queued."

 ;

K ; Kill and exit.

 K P,X,Y

 Q

 ;

DEQ ; Queued entry point.

 K ^TMP("PSIV",$J)

 U IO D @("SORT"_P("TYP")) I '$D(^TMP("PSIV",$J)) W !!,"NO " W:P("TYP")#2=1 "IV FLUID" W:P("TYP")=3 " OR " W:P("TYP")>1 "INPATIENT MEDICATION" W " QUICK ORDERS FOUND",!! D K Q

 S UL80="",$P(UL80,"-",80)="" D NOW^%DTC S HDT=$P(%,".") D HD

 F P1=0:0 S P1=$O(^TMP("PSIV",$J,P1)) Q:'P1!$D(DUOUT)  S P2="" F  S P2=$O(^TMP("PSIV",$J,P1,P2)) Q:P2=""!$D(DUOUT)  F P3=0:0 S P3=$O(^TMP("PSIV",$J,P1,P2,P3)) Q:'P3!$D(DUOUT)  D PRINT

 I $E($G(IOST))'="C" W:$Y @IOF

 E  I '$D(DUOUT) K DIR S DIR(0)="E" D ^DIR

 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC

 K %,DUOUT,HDT,ND,P,P2,P1,P3,PG,UL80,^UTILITY("PSIV",$J)

 Q

 ;

SORT1 ; List only IV Fluids.

 F P1=0:0 S P1=$O(^PS(57.1,"C",P("TYP"),P1)) Q:'P1  D SAVE

 Q

SORT2 ; List only Inpatient Meds.

 F P1=0:0 S P1=$O(^PS(57.1,"C",P("TYP"),P1)) Q:'P1  D SAVE

 Q

SORT3 ; List all.

 F P1=0:0 S P1=$O(^PS(57.1,P1)) Q:'P1  D SAVE

 Q

 ;

SAVE ; Sort order data.

 S ND=$G(^PS(57.1,P1,0)),^TMP("PSIV",$J,+$P(ND,U,3),$P(ND,U),P1)=""

 Q

 ;

PRINT ; Print Quick Orders.

 S ND=$G(^PS(57.1,+P3,0)),P("QOP")=$P(ND,U,2) S:P("QOP") P("QOP")=$P($G(^ORD(101,+P("QOP"),0)),U) I $Y+5>IOSL D PAUSE Q:$D(DUOUT)

 W !!?8,"QUICK ORDER NAME: ",$P(ND,U),!,?20,"TYPE: ",$S(P1=1:"IV FLUID",1:"INPATIENT MEDICATION"),!,?11,"PROTOCOL NAME: ",P("QOP"),!

 D @("PRINT"_P1) Q:$D(DUOUT)  D:$Y+3>IOSL PAUSE Q:$D(DUOUT)

 S P("PCP")=$S($P($G(^PS(57.1,P3,1)),U,6)=1:"No",1:"Yes")

 W "Provider Comments Prompt: ",P("PCP"),!!,?16,"COMMENTS: "

 I $D(^PS(57.1,P3,2)) F PC=0:0 S PC=$O(^PS(57.1,P3,2,PC)) Q:'PC  D

 .S LN=$G(^PS(57.1,P3,2,PC,0))

 .F LNN=1:1:$L(LN," ") D

 ..I $X+$L($P(LN," ",LNN))>79 W !,?26

 ..W $P(LN," ",LNN)," " D:$Y+3>IOSL PAUSE Q:$D(DUOUT)

 Q:$D(DUOUT)  W ! I $Y+3>IOSL D PAUSE

 Q

 ;

PRINT1 ; Print IV Fluid order.

 I $Y+1>IOSL D PAUSE Q:$D(DUOUT)

 W ! F P("SS")=3,4 Q:$D(DUOUT)  S FIL=$S(P("SS")=3:52.6,1:52.7) W:$X>16 ! W ?16,$S(FIL=52.6:"Additive:",1:"Solution:")," " F P("DRG")=0:0 S P("DRG")=$O(^PS(57.1,P3,P("SS"),P("DRG"))) Q:'P("DRG")!$D(DUOUT)  D

 .S ND=$G(^PS(57.1,P3,P("SS"),P("DRG"),0)),P("AMT")=$P(ND,U,2),ND=$G(^PS(FIL,+$P(ND,U),0))

 .W ?26,$S($P(ND,U)]"":$P(ND,U),1:"Undefined "_$S(FIL=52.6:"Additive",1:"Solution"))," ",P("AMT"),! I $Y+1>IOSL D PAUSE Q:$D(DUOUT)

 Q:$D(DUOUT)

 W:$X>16 !

 S P("IF")=$P($G(^PS(57.1,P3,1)),U,5)

 W ?11,"Infusion Rate: ",$S(P("IF")]"":P("IF"),1:"Undefined"),!

 Q

 ;

PRINT2 ; Print Inpatient Med. order.

 I $Y+5>IOSL D PAUSE Q:$D(DUOUT)

 S ND=$G(^PS(57.1,P3,1)),P("SC")=$P(ND,U,3),P("PD")=$P($G(^PS(50.3,+$P(ND,U),0)),U),P("MR")=$P($G(^PS(51.2,+$P(ND,U,2),0)),U,3),P("DO")=$P(ND,U,4)

 F X="PD","MR","SC","DO" S:P(X)="" P(X)="Undefined"

 W !,?12,"Primary Drug: ",P("PD"),!,?10,"Dosage Ordered: ",P("DO"),!,?15,"Med Route: ",P("MR"),!,?16,"Schedule: ",P("SC"),!

 Q

 ;

PAUSE I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR Q:$D(DUOUT)

 D HD

 Q

 ;

HD ; Print report header.

 S PG=$G(PG)+1 W:$Y @IOF W !,?71,"PAGE: ",PG,!!,?21,"INPATIENT PHARMACY QUICK ORDER REPORT",?63,"DATE: ",$$WDTE^PSIVUTL(HDT),!!,UL80,!

 Q

HLP ;DIR("??") Help

 W !!?5,"Please make the appropriate selection for your Quick Orders Report!"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSJQPR   4120     printed  Mar 13, 2025@21:13:52                                                                                                                                                                                                      Page 2

PSJQPR    ;BIR/MLM-INPATIENT MEDS/IV FLUIDS QUICK ORDERS REPORT ;29 SEP 94 / 9:13 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 +2       ;

EN        ; Entry point to enter/edit Inpatient Pharmacy quick orders/protocols.

 +1        if $Y

               WRITE @IOF

           WRITE !,"  This lists Inpatient Medication and/or IV Fluid Quick Orders that have been",!

 +2        WRITE "defined in the Pharmacy Quick Orders file. You may list only IV Fluid quick",!,"orders, only Inpatient Medication quick orders, or all quick orders."

 +3        KILL DIR

           SET DIR(0)="SO^F:IV Fluids;M:Inpatient Medications;A:All"

           SET DIR("B")="All"

           SET DIR("??")="^D HLP^PSJQPR"

           DO ^DIR

           if $DATA(DIRUT)

               QUIT 

           SET P("TYP")=$SELECT(Y="F":1,Y="M":2,1:3)

 +4       ;

ENQ       ; Ask device and queue report.

 +1        WRITE !

           KILL IO("Q"),%ZIS,IOP

           SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED"

               GOTO K

 +2        if '$DATA(IO("Q"))

               GOTO DEQ

           KILL ZTDTH,ZTSAVE,ZTSK

           SET ZTIO=ION

           SET ZTSAVE("P(")=""

           SET ZTRTN="DEQ^PSJQPR"

           SET ZTDESC="IV FLUIDS QUICK ORDERS REPORT"

           KILL IO("Q")

           DO ^%ZTLOAD

           if $DATA(ZTSK)

               WRITE !,"Queued."

 +3       ;

K         ; Kill and exit.

 +1        KILL P,X,Y

 +2        QUIT 

 +3       ;

DEQ       ; Queued entry point.

 +1        KILL ^TMP("PSIV",$JOB)

 +2        USE IO

           DO @("SORT"_P("TYP"))

           IF '$DATA(^TMP("PSIV",$JOB))

               WRITE !!,"NO "

               if P("TYP")#2=1

                   WRITE "IV FLUID"

               if P("TYP")=3

                   WRITE " OR "

               if P("TYP")>1

                   WRITE "INPATIENT MEDICATION"

               WRITE " QUICK ORDERS FOUND",!!

               DO K

               QUIT 

 +3        SET UL80=""

           SET $PIECE(UL80,"-",80)=""

           DO NOW^%DTC

           SET HDT=$PIECE(%,".")

           DO HD

 +4        FOR P1=0:0

               SET P1=$ORDER(^TMP("PSIV",$JOB,P1))

               if 'P1!$DATA(DUOUT)

                   QUIT 

               SET P2=""

               FOR 

                   SET P2=$ORDER(^TMP("PSIV",$JOB,P1,P2))

                   if P2=""!$DATA(DUOUT)

                       QUIT 

                   FOR P3=0:0

                       SET P3=$ORDER(^TMP("PSIV",$JOB,P1,P2,P3))

                       if 'P3!$DATA(DUOUT)

                           QUIT 

                       DO PRINT

 +5        IF $EXTRACT($GET(IOST))'="C"

               if $Y

                   WRITE @IOF

 +6       IF '$TEST

               IF '$DATA(DUOUT)

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

 +7        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           DO ^%ZISC

 +8        KILL %,DUOUT,HDT,ND,P,P2,P1,P3,PG,UL80,^UTILITY("PSIV",$JOB)

 +9        QUIT 

 +10      ;

SORT1     ; List only IV Fluids.

 +1        FOR P1=0:0

               SET P1=$ORDER(^PS(57.1,"C",P("TYP"),P1))

               if 'P1

                   QUIT 

               DO SAVE

 +2        QUIT 

SORT2     ; List only Inpatient Meds.

 +1        FOR P1=0:0

               SET P1=$ORDER(^PS(57.1,"C",P("TYP"),P1))

               if 'P1

                   QUIT 

               DO SAVE

 +2        QUIT 

SORT3     ; List all.

 +1        FOR P1=0:0

               SET P1=$ORDER(^PS(57.1,P1))

               if 'P1

                   QUIT 

               DO SAVE

 +2        QUIT 

 +3       ;

SAVE      ; Sort order data.

 +1        SET ND=$GET(^PS(57.1,P1,0))

           SET ^TMP("PSIV",$JOB,+$PIECE(ND,U,3),$PIECE(ND,U),P1)=""

 +2        QUIT 

 +3       ;

PRINT     ; Print Quick Orders.

 +1        SET ND=$GET(^PS(57.1,+P3,0))

           SET P("QOP")=$PIECE(ND,U,2)

           if P("QOP")

               SET P("QOP")=$PIECE($GET(^ORD(101,+P("QOP"),0)),U)

           IF $Y+5>IOSL

               DO PAUSE

               if $DATA(DUOUT)

                   QUIT 

 +2        WRITE !!?8,"QUICK ORDER NAME: ",$PIECE(ND,U),!,?20,"TYPE: ",$SELECT(P1=1:"IV FLUID",1:"INPATIENT MEDICATION"),!,?11,"PROTOCOL NAME: ",P("QOP"),!

 +3        DO @("PRINT"_P1)

           if $DATA(DUOUT)

               QUIT 

           if $Y+3>IOSL

               DO PAUSE

           if $DATA(DUOUT)

               QUIT 

 +4        SET P("PCP")=$SELECT($PIECE($GET(^PS(57.1,P3,1)),U,6)=1:"No",1:"Yes")

 +5        WRITE "Provider Comments Prompt: ",P("PCP"),!!,?16,"COMMENTS: "

 +6        IF $DATA(^PS(57.1,P3,2))

               FOR PC=0:0

                   SET PC=$ORDER(^PS(57.1,P3,2,PC))

                   if 'PC

                       QUIT 

                   Begin DoDot:1

 +7                    SET LN=$GET(^PS(57.1,P3,2,PC,0))

 +8                    FOR LNN=1:1:$LENGTH(LN," ")

                           Begin DoDot:2

 +9                            IF $X+$LENGTH($PIECE(LN," ",LNN))>79

                                   WRITE !,?26

 +10                           WRITE $PIECE(LN," ",LNN)," "

                               if $Y+3>IOSL

                                   DO PAUSE

                               if $DATA(DUOUT)

                                   QUIT 

                           End DoDot:2

                   End DoDot:1

 +11       if $DATA(DUOUT)

               QUIT 

           WRITE !

           IF $Y+3>IOSL

               DO PAUSE

 +12       QUIT 

 +13      ;

PRINT1    ; Print IV Fluid order.

 +1        IF $Y+1>IOSL

               DO PAUSE

               if $DATA(DUOUT)

                   QUIT 

 +2        WRITE !

           FOR P("SS")=3,4

               if $DATA(DUOUT)

                   QUIT 

               SET FIL=$SELECT(P("SS")=3:52.6,1:52.7)

               if $X>16

                   WRITE !

               WRITE ?16,$SELECT(FIL=52.6:"Additive:",1:"Solution:")," "

               FOR P("DRG")=0:0

                   SET P("DRG")=$ORDER(^PS(57.1,P3,P("SS"),P("DRG")))

                   if 'P("DRG")!$DATA(DUOUT)

                       QUIT 

                   Begin DoDot:1

 +3                    SET ND=$GET(^PS(57.1,P3,P("SS"),P("DRG"),0))

                       SET P("AMT")=$PIECE(ND,U,2)

                       SET ND=$GET(^PS(FIL,+$PIECE(ND,U),0))

 +4                    WRITE ?26,$SELECT($PIECE(ND,U)]"":$PIECE(ND,U),1:"Undefined "_$SELECT(FIL=52.6:"Additive",1:"Solution"))," ",P("AMT"),!

                       IF $Y+1>IOSL

                           DO PAUSE

                           if $DATA(DUOUT)

                               QUIT 

                   End DoDot:1

 +5        if $DATA(DUOUT)

               QUIT 

 +6        if $X>16

               WRITE !

 +7        SET P("IF")=$PIECE($GET(^PS(57.1,P3,1)),U,5)

 +8        WRITE ?11,"Infusion Rate: ",$SELECT(P("IF")]"":P("IF"),1:"Undefined"),!

 +9        QUIT 

 +10      ;

PRINT2    ; Print Inpatient Med. order.

 +1        IF $Y+5>IOSL

               DO PAUSE

               if $DATA(DUOUT)

                   QUIT 

 +2        SET ND=$GET(^PS(57.1,P3,1))

           SET P("SC")=$PIECE(ND,U,3)

           SET P("PD")=$PIECE($GET(^PS(50.3,+$PIECE(ND,U),0)),U)

           SET P("MR")=$PIECE($GET(^PS(51.2,+$PIECE(ND,U,2),0)),U,3)

           SET P("DO")=$PIECE(ND,U,4)

 +3        FOR X="PD","MR","SC","DO"

               if P(X)=""

                   SET P(X)="Undefined"

 +4        WRITE !,?12,"Primary Drug: ",P("PD"),!,?10,"Dosage Ordered: ",P("DO"),!,?15,"Med Route: ",P("MR"),!,?16,"Schedule: ",P("SC"),!

 +5        QUIT 

 +6       ;

PAUSE      IF $EXTRACT(IOST)="C"

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               if $DATA(DUOUT)

                   QUIT 

 +1        DO HD

 +2        QUIT 

 +3       ;

HD        ; Print report header.

 +1        SET PG=$GET(PG)+1

           if $Y

               WRITE @IOF

           WRITE !,?71,"PAGE: ",PG,!!,?21,"INPATIENT PHARMACY QUICK ORDER REPORT",?63,"DATE: ",$$WDTE^PSIVUTL(HDT),!!,UL80,!

 +2        QUIT 

HLP       ;DIR("??") Help

 +1        WRITE !!?5,"Please make the appropriate selection for your Quick Orders Report!"

 +2        QUIT