- 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 Feb 18, 2025@23:51:16 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