PSOBKDE1 ;BIR/MR-Sub-routines for Backdoor Rx Order Edit ;11/25/02
;;7.0;OUTPATIENT PHARMACY;**117,133,372,402,500,518**;DEC 1997;Build 3
;
LST1 ;
W @IOF
N PSOLCNT,DIRUT,DTOUT,DUOUT,I,PSODOSCT,PSODOSFL,PSOBKDF1
W !,"This is the amount of medication the patient is to receive as one dose"
W !,"for this order. This can be a numeric value, such as 325 or 650 or an"
W !,"amount with a unit of measure such as 325MG or 650MG. You may also enter"
W !,"a free text dosage, such as 1 Tablet or 2 Tablets",!
S PSOLCNT=5,PSOBKDF1=1
;
LST ;
I '$G(PSOBKDF1) W @IOF S PSOBKDF1=1
N DIR I '$D(DOSE("DD")) D Q
. W !," No dosages are available"
. N X S X=$$GET1^DIQ(50,PSODRUG("IEN"),100,"I")
. W $S(X'=""&(DT>X):" because the Drug is now Inactive.",1:"!")
. W !," Please, enter a free text dosage, or You may select a New"
. W !," Orderable Item and Dispense Drug for this order, or you can"
. W !," enter a New Order with an Active Drug."
. S PSOLCNT=$G(PSOLCNT)+4
;
I $P(DOSE("DD",PSODRUG("IEN")),"^",5)]"" D
.W !,"VERB: "_$P(DOSE("DD",PSODRUG("IEN")),"^",10)
.S PSOLCNT=$G(PSOLCNT)+1
;
LST2 ;
I '$G(PSOBKDF1) W @IOF S PSOBKDF1=1
N PSOEND
S (PSODOSFL,PSODOSCT)=0
F I=0:0 S I=$O(DOSE(I)) Q:'I!('$D(DOSE(I))) S PSODOSCT=I
I PSODOSCT=1,$P(DOSE(1),"^")=""&($P(DOSE(1),"^",3)="") S PSODOSFL=1
W !!,"There "_$S(PSODOSFL:"are NO",PSODOSCT=1&('PSODOSFL):"is ",1:"are ")_$S(PSODOSFL:"",1:PSODOSCT)_" Available Dosage(s)"_$S(PSODOSFL:".",1:":")
F I=0:0 S I=$O(DOSE(I)) Q:'I!('$D(DOSE(I))) D
.S PSOLCNT=$G(PSOLCNT)+1
.W:'$G(PSODOSFL) !?5,$J(I,3)_". "_$S($P(DOSE(I),"^"):$P(DOSE(I),"^")_$S($P(DOSE("DD",PSODRUG("IEN")),"^",6)]"":$P(DOSE("DD",PSODRUG("IEN")),"^",6),1:""),$P(DOSE(I),"^",3)'="":$P(DOSE(I),"^",3),1:"Please Enter a Free Text Dosage.")
.I ($Y>19),(I>2)&(PSODOSCT>0) D PAUSE S PSOLCNT=0 W !
K DIRUT,DIR
Q
;
PAUSE ;
Q:PSODOSCT=I
N DIR
S DIR("A")="Enter RETURN to view additional dosages or '^' to exit the list of dosages"
S DIR(0)="E" W !
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S I=9999 Q
W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBKDE1 2076 printed Dec 13, 2024@02:24:49 Page 2
PSOBKDE1 ;BIR/MR-Sub-routines for Backdoor Rx Order Edit ;11/25/02
+1 ;;7.0;OUTPATIENT PHARMACY;**117,133,372,402,500,518**;DEC 1997;Build 3
+2 ;
LST1 ;
+1 WRITE @IOF
+2 NEW PSOLCNT,DIRUT,DTOUT,DUOUT,I,PSODOSCT,PSODOSFL,PSOBKDF1
+3 WRITE !,"This is the amount of medication the patient is to receive as one dose"
+4 WRITE !,"for this order. This can be a numeric value, such as 325 or 650 or an"
+5 WRITE !,"amount with a unit of measure such as 325MG or 650MG. You may also enter"
+6 WRITE !,"a free text dosage, such as 1 Tablet or 2 Tablets",!
+7 SET PSOLCNT=5
SET PSOBKDF1=1
+8 ;
LST ;
+1 IF '$GET(PSOBKDF1)
WRITE @IOF
SET PSOBKDF1=1
+2 NEW DIR
IF '$DATA(DOSE("DD"))
Begin DoDot:1
+3 WRITE !," No dosages are available"
+4 NEW X
SET X=$$GET1^DIQ(50,PSODRUG("IEN"),100,"I")
+5 WRITE $SELECT(X'=""&(DT>X):" because the Drug is now Inactive.",1:"!")
+6 WRITE !," Please, enter a free text dosage, or You may select a New"
+7 WRITE !," Orderable Item and Dispense Drug for this order, or you can"
+8 WRITE !," enter a New Order with an Active Drug."
+9 SET PSOLCNT=$GET(PSOLCNT)+4
End DoDot:1
QUIT
+10 ;
+11 IF $PIECE(DOSE("DD",PSODRUG("IEN")),"^",5)]""
Begin DoDot:1
+12 WRITE !,"VERB: "_$PIECE(DOSE("DD",PSODRUG("IEN")),"^",10)
+13 SET PSOLCNT=$GET(PSOLCNT)+1
End DoDot:1
+14 ;
LST2 ;
+1 IF '$GET(PSOBKDF1)
WRITE @IOF
SET PSOBKDF1=1
+2 NEW PSOEND
+3 SET (PSODOSFL,PSODOSCT)=0
+4 FOR I=0:0
SET I=$ORDER(DOSE(I))
if 'I!('$DATA(DOSE(I)))
QUIT
SET PSODOSCT=I
+5 IF PSODOSCT=1
IF $PIECE(DOSE(1),"^")=""&($PIECE(DOSE(1),"^",3)="")
SET PSODOSFL=1
+6 WRITE !!,"There "_$SELECT(PSODOSFL:"are NO",PSODOSCT=1&('PSODOSFL):"is ",1:"are ")_$SELECT(PSODOSFL:"",1:PSODOSCT)_" Available Dosage(s)"_$SELECT(PSODOSFL:".",1:":")
+7 FOR I=0:0
SET I=$ORDER(DOSE(I))
if 'I!('$DATA(DOSE(I)))
QUIT
Begin DoDot:1
+8 SET PSOLCNT=$GET(PSOLCNT)+1
+9 if '$GET(PSODOSFL)
WRITE !?5,$JUSTIFY(I,3)_". "_$SELECT($PIECE(DOSE(I),"^"):$PIECE(DOSE(I),"^")_$SELECT($PIECE(DOSE("DD",PSODRUG("IEN")),"^",6)]"":$PIECE(DOSE("DD",PSODRUG("IEN")),"^",6),1:""),$PIECE(DOSE(I),"^",3)'="":...
... $PIECE(DOSE(I),"^",3),1:"Please Enter a Free Text Dosage.")
+10 IF ($Y>19)
IF (I>2)&(PSODOSCT>0)
DO PAUSE
SET PSOLCNT=0
WRITE !
End DoDot:1
+11 KILL DIRUT,DIR
+12 QUIT
+13 ;
PAUSE ;
+1 if PSODOSCT=I
QUIT
+2 NEW DIR
+3 SET DIR("A")="Enter RETURN to view additional dosages or '^' to exit the list of dosages"
+4 SET DIR(0)="E"
WRITE !
+5 DO ^DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
SET I=9999
QUIT
+7 WRITE @IOF
+8 QUIT
