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 ---[H[J[2J[HPSJQPR 4120 printed Nov 22, 2024@17:19:05 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