- ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;Feb 18, 2021@14:20:11
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131,243,311,350,377,413,405**;Dec 17, 1997;Build 211
- ;
- COMPLEX() ; -- Single or complex?
- N X,Y,DIR,DUOUT,DTOUT,COMPLX
- S COMPLX=$S($O(ORDIALOG(PROMPT,"?"),-1)>1:1,$L($G(ORDIALOG($$PTR("DURATION"),1))):1,1:0)
- I $G(ORTYPE)="Z",ORDG=$O(^ORD(100.98,"B","NON-VA MEDICATIONS",0)),FIRST Q COMPLX
- I $G(ORTYPE)="Q",$O(ORDIALOG(PROMPT,0)),FIRST Q COMPLX
- I $D(ORENEW)!$D(OREWRITE)!$D(ORXFER)!COMPLX Q COMPLX
- I $D(OREDIT) Q:$D(ORCOMPLX)!COMPLX COMPLX G CP1 ;Q if complex or 'first, else ask
- I 'FIRST S Y=$S($D(ORCOMPLX):ORCOMPLX,1:COMPLX) Q Y
- CP1 S DIR(0)="YA",DIR("A")="Complex dose? ",DIR("B")="NO"
- S DIR("?")="Enter YES if you wish to enter multiple sets of dosage instructions, a tapering dose, or to limit the duration of a single dose."
- D ^DIR S:$D(DTOUT) Y="^"
- Q Y
- ;
- DOSES ; -- Available common doses
- ;S $P(ORDIALOG(PROMPT,0),U,2)=$S(ORCAT="I":"1:20",1:"1:80")
- S ORDIALOG(PROMPT,"A")="Dose"_$S(ORCAT="I"&$G(ORIV):" or Rate: ",1:": ")
- S $P(ORDIALOG(PROMPT,"?"),",",2)=$S($G(ORIV):" as either a dose amount or infusion rate.",1:" as a dose or amount.")
- I FIRST,'$O(ORDIALOG(PROMPT,0)),$G(ORXFER) D SHOWSIG^ORCMED
- S ORCOMPLX=$$COMPLEX,MULT=+ORCOMPLX I ORCOMPLX="^" S ORQUIT=1 Q
- Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$D(ORDOSE)
- D1 ; -- Entry from ORCMED,NF^ORCDPS to build list
- N I,J,X,DD,DRUG,DOSE,CONJ,CNT,UD,COST,TEXT
- S (I,CNT)=0,CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
- F S I=$O(ORDOSE(I)) Q:I'>0 D
- . S X=ORDOSE(I),DD=+$P(X,U,6),DRUG=ORDOSE("DD",DD)
- . ; =TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN^Cost
- . ;DD=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills?
- . S DOSE=$P(X,U,5),UD=$P(X,U,3),COST=$P(X,U,7) Q:'$L(DOSE)
- . I '$P(X,U) S DOSE=DOSE_CONJ_" "_$S($L($P(DRUG,U,5)):$P(DRUG,U,5)_$P(DRUG,U,6),1:$P(DRUG,U))
- . ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4)
- . S TEXT=DOSE_$S($L(COST):" $"_COST,1:"")_$S($P(DRUG,U,3):" (non-formulary)",1:"")
- . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=DOSE_U_TEXT
- . S ORDIALOG(PROMPT,"LIST","B",TEXT)=DOSE
- . S ORDIALOG(PROMPT,"LIST","D",DOSE)=DD ;default DispDrug
- . S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I),U,1,6)_U_$P(DRUG,U,5,6)
- . S J=0 F S J=$O(ORDOSE(I,J)) Q:J'>0 D ;xref alt forms of dose
- .. S DD=+$P(ORDOSE(I,J),U,6),DRUG=$G(ORDOSE("DD",DD))
- .. S ORDOSE("DD",DD,DOSE)=$P(ORDOSE(I,J),U,1,6)_U_$P(DRUG,U,5,6)
- S:CNT ORDIALOG(PROMPT,"LIST")=CNT
- Q
- ;
- CHDOSE ; -- Kill dependent values if inst ORI of dose changes
- N X,PROMPTS,P,NAME,DOSE,DD S X=$G(ORDIALOG(PROMPT,ORI))
- ;S X=$$UP^XLFSTR(X),ORDIALOG(PROMPT,ORI)=X ;force uppercase
- I X,X'?1.N.E1.A.E K DONE W $C(7),!,"Enter the amount of this drug that the patient is to receive as a dose,",!,"NOT as the number of units per dose." Q
- ; OR*377 djh use "D" index, the DOSE instructions w/out any pricing
- I $L(X)>60,'$D(ORDIALOG(PROMPT,"LIST","D",X)) K DONE W $C(7),!,"Instructions may not be longer than 60 characters." Q
- I $G(ORESET)'=X D ;kill dependent values if new/changed dose
- . S PROMPTS="STRENGTH^DRUG NAME^DOSE^DISPENSE DRUG^DAYS SUPPLY^QUANTITY^REFILLS"
- . F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) K ORDIALOG($$PTR(NAME),ORI)
- . K ORQTY,ORQTYUNT,ORDRUG,ORDIALOG($$PTR("DISPENSE DRUG"),1)
- . K ^TMP("ORWORD",$J,$$PTR("SIG"))
- S DOSE=$$PTR("DOSE") I $L(X),'$L($G(ORDIALOG(DOSE,ORI))) D ;set ID
- . S DD=+$G(ORDIALOG(PROMPT,"LIST","D",X))
- . S:DD ORDIALOG(DOSE,ORI)=$TR($G(ORDOSE("DD",DD,X)),"^","&")
- S DD=+$P($G(ORDIALOG(DOSE,ORI)),"&",6)
- I DD,$P($G(ORDOSE("DD",DD)),U,3) D NF^ORCDPS(DD) ;look for FormAlt
- I 'DD,(+$G(ORDOSE("LOCAL"))) W $C(7),!,"WARNING: Dosage check may not occur."
- Q
- ;
- EXDOSE ; -- Exit Action
- Q:'$O(ORDIALOG(PROMPT,0)) N DRUG,MISC,QUIT,LAST
- S ORDRUG=$$DISPDRUG^ORCDPS,DRUG=$G(ORDOSE("DD",+ORDRUG))
- I ORDRUG D I $G(QUIT) S ORQUIT=1 Q
- . ;I $P(DRUG,U,10),'$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S QUIT=1 Q
- . ;I $P(DRUG,U,10)=1 W $C(7),!,"This order will require a wet signature!"
- . S ORDIALOG($$PTR("DISPENSE DRUG"),1)=ORDRUG
- . D:$G(ORCAT)="O" RESETID^ORCDPS
- . N STR,MED S STR=$P(DRUG,U,5)_$P(DRUG,U,6)
- . I STR'>0 S:'$G(ORDOSE(1)) ORDIALOG($$PTR("DRUG NAME"),1)=$P(DRUG,U) Q
- . S MED=$P($G(^ORD(101.43,+$G(OROI),0)),U)
- . I MED'[STR,ORCAT="O"!'$G(ORDOSE(1)) S ORDIALOG($$PTR("STRENGTH"),1)=STR
- I +ORDRUG'>0,ORCAT="O" W $C(7),!,"Cannot determine dispense drug - some defaults and order checks may not occur!"
- EXD1 ; -- Kill dangling conjunction, [re]build Sig, get Qty info
- S LAST=$O(ORDIALOG(PROMPT,"?"),-1) K ORDIALOG($$PTR("AND/THEN"),LAST)
- D ADMIN^ORCDPS3 D:$G(ORTYPE)'="Z" SIG ;[re]build Sig/Text
- I ORDRUG,ORCAT="O" D ;set Qty info
- . S:$L($P(DRUG,U,4)) ORQTYUNT=$P(DRUG,U,4)
- . S MISC=$$ENDCM^PSJORUTL(+ORDRUG),ORQTY=$P(MISC,U,4)
- . W:$L($P(MISC,U,2)) !!,$P(MISC,U,2),!
- Q
- ;
- SIG ; -- Create ORDIALOG(SIG) from Instructions PROMPT,ORDOSE,ORDRUG,ORCAT
- ; Return text in ^TMP("ORWORD",$J,SIG,INST)
- ; [also called from PSJ^ORCSEND1 to build child orders]
- ;
- N ORT,ORSCH,ORDUR,ORID,ORDD,ORCNJ,ORMISC,ORPREP,ORX,ORI,CNT,ORSIG,ORS,DOSE
- S ORT=$$PTR("ROUTE"),ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION")
- S ORID=$$PTR("DOSE"),ORCNJ=$$PTR("AND/THEN"),ORS=$$PTR("SIG")
- S ORMISC=$G(ORDOSE("MISC")),ORPREP=$P(ORMISC,U,2)
- S ORX=$S(ORCAT="I":"",ORCAT="O"&(+$G(ISIMO)=1):"",$L($P(ORMISC,U)):$P(ORMISC,U)_" ",1:"") ;"TAKE "
- S (CNT,ORI)=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0 D
- . S DOSE=$G(ORDIALOG(PROMPT,ORI)) Q:'$L(DOSE)
- . S ORX=ORX_$$DOSE_$$RTE_$$SCH_$$DUR_$$CONJ
- . S CNT=CNT+1,ORSIG(CNT,0)=ORX,ORX=""
- Q:CNT'>0 S ORSIG(0)="^^"_CNT_U_CNT_U_DT_U
- K ^TMP("ORWORD",$J,ORS,1) M ^(1)=ORSIG S ORDIALOG(PROMPT,"FORMAT")="@"
- S ORDIALOG(ORS,1)=$NA(^TMP("ORWORD",$J,ORS,1))
- Q
- ;
- PTR(X) ; -- Ptr to prompt OR GTX X
- Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
- ;
- DOSE() ; -- Dosage
- N X0,Y S X0=$G(ORDIALOG(ORID,ORI)) ;ID string
- S Y=DOSE I ORDRUG,$L(X0) D ;use local dose if common DispDrug
- . S:$L($P(X0,"&",5)) Y=$P(X0,"&",5) ;unless Outpt w/total dose
- . I ORCAT="O",X0,'+$G(ISIMO) S Y=$$WORD($P(X0,"&",3))_" "_$P(X0,"&",4) ;u/d
- Q Y
- ;
- WORD(X) ; -- Words for number X
- N X1,X2,Y S X1=$P(+X,"."),X2=$P(+X,".",2)
- S Y="" I X1 S Y=$S(X1=1:"ONE",X1=2:"TWO",X1=3:"THREE",X1=4:"FOUR",X1=5:"FIVE",X1=6:"SIX",X1=7:"SEVEN",X1=8:"EIGHT",X1=9:"NINE",X1=10:"TEN",1:X1)
- I X2 S Y=Y_$S($L(Y):" AND ",1:"")_$S(X2=5:"ONE-HALF",X2=33!(X2=34):"ONE-THIRD",X2=25:"ONE-FOURTH",X2=66!(X2=67):"TWO-THIRDS",X2=75:"THREE-FOURTHS",1:"."_X2)
- Q Y
- ;
- RTE() ; -- Expansion of route
- N X,X0,Y S X=+$G(ORDIALOG(ORT,ORI)) Q:X'>0 ""
- K ^TMP($J,"ORCDPS2 RTE")
- D ALL^PSS51P2(+X,,,,"ORCDPS2 RTE")
- ;S X0=$G(^PS(51.2,+X,0)),Y=""
- I ORCAT="I"!(+$G(ISIMO)=1) S Y=" "_$S($L(^TMP($J,"ORCDPS2 RTE",+X,1)):^TMP($J,"ORCDPS2 RTE",+X,1),1:^TMP($J,"ORCDPS2 RTE",+X,.01))
- ;I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U))
- I ORCAT="O",'+$G(ISIMO) S Y=" "_$S($L(ORPREP):ORPREP_" ",1:"")_$S($L(^TMP($J,"ORCDPS2 RTE",+X,4)):^TMP($J,"ORCDPS2 RTE",+X,4),1:^TMP($J,"ORCDPS2 RTE",+X,.01))
- Q Y
- ;
- SCH() ; -- [outpatient] expansion of schedule
- N X,Y S X=$G(ORDIALOG(ORSCH,ORI))
- I $L(X),ORCAT="O",'+$G(ISIMO) D SCH^PSSUTIL1(.X)
- S Y=$S($L(X):" "_X,1:"")
- Q Y
- ;
- DUR() ; -- Duration
- N X,Y S X=$G(ORDIALOG(ORDUR,ORI)),Y=""
- I X S Y=" FOR "_$$UP^XLFSTR(X)_$S(+X=X:" DAYS",1:"")
- Q Y
- ;
- CONJ() ; -- Conjunction
- N X,Y S X=$G(ORDIALOG(ORCNJ,ORI))
- S:$L(X)>1 X=$E(X) S:X="E" S="X"
- S Y=$S(X="T":", THEN",X="X":" EXCEPT",X="A":" AND",1:"")
- Q Y
- ;
- DOSETEXT ; -- Reset dose text in ORDIALOG(INSTR) for backdoor orders
- ; [Called from ORMPS1 - uses ORCAT,PSOI,ORVP,DRUG,INSTR,DOSE]
- ;
- N ORTYPE,ORDOSE,CONJ,ORDRUG,DRUG0,STRG,ORI,LDOSE,ORDLGDOSE,PROMPT,ORTEXTADD,ORJ,ORK
- S ORTYPE=$S($G(ORCAT)="I":"U",1:"O")
- D DOSE^PSSORUTL(.ORDOSE,+PSOI,ORTYPE,+ORVP)
- S CONJ=$P($G(ORDOSE("MISC")),U,3) S:$L(CONJ) CONJ=" "_CONJ
- S ORDRUG=+$G(ORDIALOG(DRUG,1)),DRUG0=$G(ORDOSE("DD",ORDRUG))
- S STRG=$P(DRUG0,U,5)_$P(DRUG0,U,6)
- I '$G(ORDOSE(1)) S ORI=0 F S ORI=$O(ORDIALOG(INSTR,ORI)) Q:ORI'>0 D
- . S LDOSE=$G(ORDIALOG(INSTR,ORI))
- . S ORDLGDOSE=$G(ORDIALOG(DOSE,ORI))
- . I '$L(ORDLGDOSE) Q
- . I ORDLGDOSE Q
- . S ORTEXTADD=CONJ_" "_$S(STRG:STRG,1:$P(DRUG0,U,1))
- . ;
- . ; Check if strength/drug name is already appended to LDOSE
- . S ORJ=$L(LDOSE)
- . S ORK=$L(ORTEXTADD)
- . I ORK,ORJ>ORK,$E(LDOSE,ORJ-ORK+1,ORJ)=ORTEXTADD Q
- . ;
- . S ORDIALOG(INSTR,ORI)=LDOSE_ORTEXTADD
- ; -build Sig/Text if not defined
- I '$D(ORDIALOG(+$$PTR("SIG"),1)) S PROMPT=INSTR D SIG
- Q
- ;
- PI ; -- Include Pt Instructions w/Sig in Outpt order?
- N X,Y,DIR,DUOUT,DTOUT,DIRUT,ORTX,ORMAX,I,CNT
- I $G(ORCAT)'="O" D CLEARWP Q ;!'$O(ORDOSE("PI",0))
- Q:$G(ORENEW) S I=0,ORMAX=57
- I $G(OREDIT)!$G(OREWRITE),$O(^TMP("ORWORD",$J,PROMPT,INST,0)) K ORDOSE("PI") S I=0 F S I=$O(^TMP("ORWORD",$J,PROMPT,INST,I)) Q:I<1 S ORDOSE("PI",I)=$G(^(I,0))
- I '$O(ORDOSE("PI",0)) D CLEARWP Q
- F S I=$O(ORDOSE("PI",I)) Q:I'>0 S X=ORDOSE("PI",I) D TXT^ORCHTAB
- S DIR(0)="YA",DIR("A")="Include Patient Instructions in Sig? "
- S DIR("?")="Enter NO if you do not want these instructions included in the sig for this order",DIR("B")=$S($D(^TMP("ORWORD",$J,PROMPT)):"YES",1:"NO")
- W ! S I=0 F S I=$O(ORTX(I)) Q:I'>0 W !,$S(I=1:"Patient Instructions: ",1:" ")_ORTX(I)
- D ^DIR I $D(DUOUT)!$D(DTOUT) S ORQUIT=1 Q
- I Y D Q ;save text
- . K ^TMP("ORWORD",$J,PROMPT,INST) S CNT=0
- . S I=0 F S I=$O(ORDOSE("PI",I)) Q:I'>0 S ^TMP("ORWORD",$J,PROMPT,INST,I,0)=ORDOSE("PI",I),CNT=CNT+1
- . S ^TMP("ORWORD",$J,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U
- . S ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$J_","_PROMPT_","_INST_")"
- I Y'>0 K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST)
- Q
- ;
- CLEARWP ; -- Clear INST of wp field PROMPT
- K ORDIALOG(PROMPT,INST),^TMP("ORWORD",$J,PROMPT,INST)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDPS2 10035 printed Jan 18, 2025@03:29:20 Page 2
- ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;Feb 18, 2021@14:20:11
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131,243,311,350,377,413,405**;Dec 17, 1997;Build 211
- +2 ;
- COMPLEX() ; -- Single or complex?
- +1 NEW X,Y,DIR,DUOUT,DTOUT,COMPLX
- +2 SET COMPLX=$SELECT($ORDER(ORDIALOG(PROMPT,"?"),-1)>1:1,$LENGTH($GET(ORDIALOG($$PTR("DURATION"),1))):1,1:0)
- +3 IF $GET(ORTYPE)="Z"
- IF ORDG=$ORDER(^ORD(100.98,"B","NON-VA MEDICATIONS",0))
- IF FIRST
- QUIT COMPLX
- +4 IF $GET(ORTYPE)="Q"
- IF $ORDER(ORDIALOG(PROMPT,0))
- IF FIRST
- QUIT COMPLX
- +5 IF $DATA(ORENEW)!$DATA(OREWRITE)!$DATA(ORXFER)!COMPLX
- QUIT COMPLX
- +6 ;Q if complex or 'first, else ask
- IF $DATA(OREDIT)
- if $DATA(ORCOMPLX)!COMPLX
- QUIT COMPLX
- GOTO CP1
- +7 IF 'FIRST
- SET Y=$SELECT($DATA(ORCOMPLX):ORCOMPLX,1:COMPLX)
- QUIT Y
- CP1 SET DIR(0)="YA"
- SET DIR("A")="Complex dose? "
- SET DIR("B")="NO"
- +1 SET DIR("?")="Enter YES if you wish to enter multiple sets of dosage instructions, a tapering dose, or to limit the duration of a single dose."
- +2 DO ^DIR
- if $DATA(DTOUT)
- SET Y="^"
- +3 QUIT Y
- +4 ;
- DOSES ; -- Available common doses
- +1 ;S $P(ORDIALOG(PROMPT,0),U,2)=$S(ORCAT="I":"1:20",1:"1:80")
- +2 SET ORDIALOG(PROMPT,"A")="Dose"_$SELECT(ORCAT="I"&$GET(ORIV):" or Rate: ",1:": ")
- +3 SET $PIECE(ORDIALOG(PROMPT,"?"),",",2)=$SELECT($GET(ORIV):" as either a dose amount or infusion rate.",1:" as a dose or amount.")
- +4 IF FIRST
- IF '$ORDER(ORDIALOG(PROMPT,0))
- IF $GET(ORXFER)
- DO SHOWSIG^ORCMED
- +5 SET ORCOMPLX=$$COMPLEX
- SET MULT=+ORCOMPLX
- IF ORCOMPLX="^"
- SET ORQUIT=1
- QUIT
- +6 if $GET(ORDIALOG(PROMPT,"LIST"))
- QUIT
- if '$DATA(ORDOSE)
- QUIT
- D1 ; -- Entry from ORCMED,NF^ORCDPS to build list
- +1 NEW I,J,X,DD,DRUG,DOSE,CONJ,CNT,UD,COST,TEXT
- +2 SET (I,CNT)=0
- SET CONJ=$PIECE($GET(ORDOSE("MISC")),U,3)
- if $LENGTH(CONJ)
- SET CONJ=" "_CONJ
- +3 FOR
- SET I=$ORDER(ORDOSE(I))
- if I'>0
- QUIT
- Begin DoDot:1
- +4 SET X=ORDOSE(I)
- SET DD=+$PIECE(X,U,6)
- SET DRUG=ORDOSE("DD",DD)
- +5 ; =TotalDose^Units^U/D^Noun^LocalDose^DispDrugIEN^Cost
- +6 ;DD=Name^Cost^NF^DispUnit^Strength^Units^DoseForm^MaxRefills?
- +7 SET DOSE=$PIECE(X,U,5)
- SET UD=$PIECE(X,U,3)
- SET COST=$PIECE(X,U,7)
- if '$LENGTH(DOSE)
- QUIT
- +8 IF '$PIECE(X,U)
- SET DOSE=DOSE_CONJ_" "_$SELECT($LENGTH($PIECE(DRUG,U,5)):$PIECE(DRUG,U,5)_$PIECE(DRUG,U,6),1:$PIECE(DRUG,U))
- +9 ;I UD S COST="$"_$J(UD*$P(DRUG,U,2),1,3) ;_" per "_UD_" "_$P(X,U,4)
- +10 SET TEXT=DOSE_$SELECT($LENGTH(COST):" $"_COST,1:"")_$SELECT($PIECE(DRUG,U,3):" (non-formulary)",1:"")
- +11 SET CNT=CNT+1
- SET ORDIALOG(PROMPT,"LIST",CNT)=DOSE_U_TEXT
- +12 SET ORDIALOG(PROMPT,"LIST","B",TEXT)=DOSE
- +13 ;default DispDrug
- SET ORDIALOG(PROMPT,"LIST","D",DOSE)=DD
- +14 SET ORDOSE("DD",DD,DOSE)=$PIECE(ORDOSE(I),U,1,6)_U_$PIECE(DRUG,U,5,6)
- +15 ;xref alt forms of dose
- SET J=0
- FOR
- SET J=$ORDER(ORDOSE(I,J))
- if J'>0
- QUIT
- Begin DoDot:2
- +16 SET DD=+$PIECE(ORDOSE(I,J),U,6)
- SET DRUG=$GET(ORDOSE("DD",DD))
- +17 SET ORDOSE("DD",DD,DOSE)=$PIECE(ORDOSE(I,J),U,1,6)_U_$PIECE(DRUG,U,5,6)
- End DoDot:2
- End DoDot:1
- +18 if CNT
- SET ORDIALOG(PROMPT,"LIST")=CNT
- +19 QUIT
- +20 ;
- CHDOSE ; -- Kill dependent values if inst ORI of dose changes
- +1 NEW X,PROMPTS,P,NAME,DOSE,DD
- SET X=$GET(ORDIALOG(PROMPT,ORI))
- +2 ;S X=$$UP^XLFSTR(X),ORDIALOG(PROMPT,ORI)=X ;force uppercase
- +3 IF X
- IF X'?1.N.E1.A.E
- KILL DONE
- WRITE $CHAR(7),!,"Enter the amount of this drug that the patient is to receive as a dose,",!,"NOT as the number of units per dose."
- QUIT
- +4 ; OR*377 djh use "D" index, the DOSE instructions w/out any pricing
- +5 IF $LENGTH(X)>60
- IF '$DATA(ORDIALOG(PROMPT,"LIST","D",X))
- KILL DONE
- WRITE $CHAR(7),!,"Instructions may not be longer than 60 characters."
- QUIT
- +6 ;kill dependent values if new/changed dose
- IF $GET(ORESET)'=X
- Begin DoDot:1
- +7 SET PROMPTS="STRENGTH^DRUG NAME^DOSE^DISPENSE DRUG^DAYS SUPPLY^QUANTITY^REFILLS"
- +8 FOR P=1:1:$LENGTH(PROMPTS,U)
- SET NAME=$PIECE(PROMPTS,U,P)
- KILL ORDIALOG($$PTR(NAME),ORI)
- +9 KILL ORQTY,ORQTYUNT,ORDRUG,ORDIALOG($$PTR("DISPENSE DRUG"),1)
- +10 KILL ^TMP("ORWORD",$JOB,$$PTR("SIG"))
- End DoDot:1
- +11 ;set ID
- SET DOSE=$$PTR("DOSE")
- IF $LENGTH(X)
- IF '$LENGTH($GET(ORDIALOG(DOSE,ORI)))
- Begin DoDot:1
- +12 SET DD=+$GET(ORDIALOG(PROMPT,"LIST","D",X))
- +13 if DD
- SET ORDIALOG(DOSE,ORI)=$TRANSLATE($GET(ORDOSE("DD",DD,X)),"^","&")
- End DoDot:1
- +14 SET DD=+$PIECE($GET(ORDIALOG(DOSE,ORI)),"&",6)
- +15 ;look for FormAlt
- IF DD
- IF $PIECE($GET(ORDOSE("DD",DD)),U,3)
- DO NF^ORCDPS(DD)
- +16 IF 'DD
- IF (+$GET(ORDOSE("LOCAL")))
- WRITE $CHAR(7),!,"WARNING: Dosage check may not occur."
- +17 QUIT
- +18 ;
- EXDOSE ; -- Exit Action
- +1 if '$ORDER(ORDIALOG(PROMPT,0))
- QUIT
- NEW DRUG,MISC,QUIT,LAST
- +2 SET ORDRUG=$$DISPDRUG^ORCDPS
- SET DRUG=$GET(ORDOSE("DD",+ORDRUG))
- +3 IF ORDRUG
- Begin DoDot:1
- +4 ;I $P(DRUG,U,10),'$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) W $C(7),!,$P($G(^(0)),U)_" must have a DEA# or VA# to order this drug!" S QUIT=1 Q
- +5 ;I $P(DRUG,U,10)=1 W $C(7),!,"This order will require a wet signature!"
- +6 SET ORDIALOG($$PTR("DISPENSE DRUG"),1)=ORDRUG
- +7 if $GET(ORCAT)="O"
- DO RESETID^ORCDPS
- +8 NEW STR,MED
- SET STR=$PIECE(DRUG,U,5)_$PIECE(DRUG,U,6)
- +9 IF STR'>0
- if '$GET(ORDOSE(1))
- SET ORDIALOG($$PTR("DRUG NAME"),1)=$PIECE(DRUG,U)
- QUIT
- +10 SET MED=$PIECE($GET(^ORD(101.43,+$GET(OROI),0)),U)
- +11 IF MED'[STR
- IF ORCAT="O"!'$GET(ORDOSE(1))
- SET ORDIALOG($$PTR("STRENGTH"),1)=STR
- End DoDot:1
- IF $GET(QUIT)
- SET ORQUIT=1
- QUIT
- +12 IF +ORDRUG'>0
- IF ORCAT="O"
- WRITE $CHAR(7),!,"Cannot determine dispense drug - some defaults and order checks may not occur!"
- EXD1 ; -- Kill dangling conjunction, [re]build Sig, get Qty info
- +1 SET LAST=$ORDER(ORDIALOG(PROMPT,"?"),-1)
- KILL ORDIALOG($$PTR("AND/THEN"),LAST)
- +2 ;[re]build Sig/Text
- DO ADMIN^ORCDPS3
- if $GET(ORTYPE)'="Z"
- DO SIG
- +3 ;set Qty info
- IF ORDRUG
- IF ORCAT="O"
- Begin DoDot:1
- +4 if $LENGTH($PIECE(DRUG,U,4))
- SET ORQTYUNT=$PIECE(DRUG,U,4)
- +5 SET MISC=$$ENDCM^PSJORUTL(+ORDRUG)
- SET ORQTY=$PIECE(MISC,U,4)
- +6 if $LENGTH($PIECE(MISC,U,2))
- WRITE !!,$PIECE(MISC,U,2),!
- End DoDot:1
- +7 QUIT
- +8 ;
- SIG ; -- Create ORDIALOG(SIG) from Instructions PROMPT,ORDOSE,ORDRUG,ORCAT
- +1 ; Return text in ^TMP("ORWORD",$J,SIG,INST)
- +2 ; [also called from PSJ^ORCSEND1 to build child orders]
- +3 ;
- +4 NEW ORT,ORSCH,ORDUR,ORID,ORDD,ORCNJ,ORMISC,ORPREP,ORX,ORI,CNT,ORSIG,ORS,DOSE
- +5 SET ORT=$$PTR("ROUTE")
- SET ORSCH=$$PTR("SCHEDULE")
- SET ORDUR=$$PTR("DURATION")
- +6 SET ORID=$$PTR("DOSE")
- SET ORCNJ=$$PTR("AND/THEN")
- SET ORS=$$PTR("SIG")
- +7 SET ORMISC=$GET(ORDOSE("MISC"))
- SET ORPREP=$PIECE(ORMISC,U,2)
- +8 ;"TAKE "
- SET ORX=$SELECT(ORCAT="I":"",ORCAT="O"&(+$GET(ISIMO)=1):"",$LENGTH($PIECE(ORMISC,U)):$PIECE(ORMISC,U)_" ",1:"")
- +9 SET (CNT,ORI)=0
- FOR
- SET ORI=$ORDER(ORDIALOG(PROMPT,ORI))
- if ORI'>0
- QUIT
- Begin DoDot:1
- +10 SET DOSE=$GET(ORDIALOG(PROMPT,ORI))
- if '$LENGTH(DOSE)
- QUIT
- +11 SET ORX=ORX_$$DOSE_$$RTE_$$SCH_$$DUR_$$CONJ
- +12 SET CNT=CNT+1
- SET ORSIG(CNT,0)=ORX
- SET ORX=""
- End DoDot:1
- +13 if CNT'>0
- QUIT
- SET ORSIG(0)="^^"_CNT_U_CNT_U_DT_U
- +14 KILL ^TMP("ORWORD",$JOB,ORS,1)
- MERGE ^(1)=ORSIG
- SET ORDIALOG(PROMPT,"FORMAT")="@"
- +15 SET ORDIALOG(ORS,1)=$NAME(^TMP("ORWORD",$JOB,ORS,1))
- +16 QUIT
- +17 ;
- PTR(X) ; -- Ptr to prompt OR GTX X
- +1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
- +2 ;
- DOSE() ; -- Dosage
- +1 ;ID string
- NEW X0,Y
- SET X0=$GET(ORDIALOG(ORID,ORI))
- +2 ;use local dose if common DispDrug
- SET Y=DOSE
- IF ORDRUG
- IF $LENGTH(X0)
- Begin DoDot:1
- +3 ;unless Outpt w/total dose
- if $LENGTH($PIECE(X0,"&",5))
- SET Y=$PIECE(X0,"&",5)
- +4 ;u/d
- IF ORCAT="O"
- IF X0
- IF '+$GET(ISIMO)
- SET Y=$$WORD($PIECE(X0,"&",3))_" "_$PIECE(X0,"&",4)
- End DoDot:1
- +5 QUIT Y
- +6 ;
- WORD(X) ; -- Words for number X
- +1 NEW X1,X2,Y
- SET X1=$PIECE(+X,".")
- SET X2=$PIECE(+X,".",2)
- +2 SET Y=""
- IF X1
- SET Y=$SELECT(X1=1:"ONE",X1=2:"TWO",X1=3:"THREE",X1=4:"FOUR",X1=5:"FIVE",X1=6:"SIX",X1=7:"SEVEN",X1=8:"EIGHT",X1=9:"NINE",X1=10:"TEN",1:X1)
- +3 IF X2
- SET Y=Y_$SELECT($LENGTH(Y):" AND ",1:"")_$SELECT(X2=5:"ONE-HALF",X2=33!(X2=34):"ONE-THIRD",X2=25:"ONE-FOURTH",X2=66!(X2=67):"TWO-THIRDS",X2=75:"THREE-FOURTHS",1:"."_X2)
- +4 QUIT Y
- +5 ;
- RTE() ; -- Expansion of route
- +1 NEW X,X0,Y
- SET X=+$GET(ORDIALOG(ORT,ORI))
- if X'>0
- QUIT ""
- +2 KILL ^TMP($JOB,"ORCDPS2 RTE")
- +3 DO ALL^PSS51P2(+X,,,,"ORCDPS2 RTE")
- +4 ;S X0=$G(^PS(51.2,+X,0)),Y=""
- +5 IF ORCAT="I"!(+$GET(ISIMO)=1)
- SET Y=" "_$SELECT($LENGTH(^TMP($JOB,"ORCDPS2 RTE",+X,1)):^TMP($JOB,"ORCDPS2 RTE",+X,1),1:^TMP($JOB,"ORCDPS2 RTE",+X,.01))
- +6 ;I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U))
- +7 IF ORCAT="O"
- IF '+$GET(ISIMO)
- SET Y=" "_$SELECT($LENGTH(ORPREP):ORPREP_" ",1:"")_$SELECT($LENGTH(^TMP($JOB,"ORCDPS2 RTE",+X,4)):^TMP($JOB,"ORCDPS2 RTE",+X,4),1:^TMP($JOB,"ORCDPS2 RTE",+X,.01))
- +8 QUIT Y
- +9 ;
- SCH() ; -- [outpatient] expansion of schedule
- +1 NEW X,Y
- SET X=$GET(ORDIALOG(ORSCH,ORI))
- +2 IF $LENGTH(X)
- IF ORCAT="O"
- IF '+$GET(ISIMO)
- DO SCH^PSSUTIL1(.X)
- +3 SET Y=$SELECT($LENGTH(X):" "_X,1:"")
- +4 QUIT Y
- +5 ;
- DUR() ; -- Duration
- +1 NEW X,Y
- SET X=$GET(ORDIALOG(ORDUR,ORI))
- SET Y=""
- +2 IF X
- SET Y=" FOR "_$$UP^XLFSTR(X)_$SELECT(+X=X:" DAYS",1:"")
- +3 QUIT Y
- +4 ;
- CONJ() ; -- Conjunction
- +1 NEW X,Y
- SET X=$GET(ORDIALOG(ORCNJ,ORI))
- +2 if $LENGTH(X)>1
- SET X=$EXTRACT(X)
- if X="E"
- SET S="X"
- +3 SET Y=$SELECT(X="T":", THEN",X="X":" EXCEPT",X="A":" AND",1:"")
- +4 QUIT Y
- +5 ;
- DOSETEXT ; -- Reset dose text in ORDIALOG(INSTR) for backdoor orders
- +1 ; [Called from ORMPS1 - uses ORCAT,PSOI,ORVP,DRUG,INSTR,DOSE]
- +2 ;
- +3 NEW ORTYPE,ORDOSE,CONJ,ORDRUG,DRUG0,STRG,ORI,LDOSE,ORDLGDOSE,PROMPT,ORTEXTADD,ORJ,ORK
- +4 SET ORTYPE=$SELECT($GET(ORCAT)="I":"U",1:"O")
- +5 DO DOSE^PSSORUTL(.ORDOSE,+PSOI,ORTYPE,+ORVP)
- +6 SET CONJ=$PIECE($GET(ORDOSE("MISC")),U,3)
- if $LENGTH(CONJ)
- SET CONJ=" "_CONJ
- +7 SET ORDRUG=+$GET(ORDIALOG(DRUG,1))
- SET DRUG0=$GET(ORDOSE("DD",ORDRUG))
- +8 SET STRG=$PIECE(DRUG0,U,5)_$PIECE(DRUG0,U,6)
- +9 IF '$GET(ORDOSE(1))
- SET ORI=0
- FOR
- SET ORI=$ORDER(ORDIALOG(INSTR,ORI))
- if ORI'>0
- QUIT
- Begin DoDot:1
- +10 SET LDOSE=$GET(ORDIALOG(INSTR,ORI))
- +11 SET ORDLGDOSE=$GET(ORDIALOG(DOSE,ORI))
- +12 IF '$LENGTH(ORDLGDOSE)
- QUIT
- +13 IF ORDLGDOSE
- QUIT
- +14 SET ORTEXTADD=CONJ_" "_$SELECT(STRG:STRG,1:$PIECE(DRUG0,U,1))
- +15 ;
- +16 ; Check if strength/drug name is already appended to LDOSE
- +17 SET ORJ=$LENGTH(LDOSE)
- +18 SET ORK=$LENGTH(ORTEXTADD)
- +19 IF ORK
- IF ORJ>ORK
- IF $EXTRACT(LDOSE,ORJ-ORK+1,ORJ)=ORTEXTADD
- QUIT
- +20 ;
- +21 SET ORDIALOG(INSTR,ORI)=LDOSE_ORTEXTADD
- End DoDot:1
- +22 ; -build Sig/Text if not defined
- +23 IF '$DATA(ORDIALOG(+$$PTR("SIG"),1))
- SET PROMPT=INSTR
- DO SIG
- +24 QUIT
- +25 ;
- PI ; -- Include Pt Instructions w/Sig in Outpt order?
- +1 NEW X,Y,DIR,DUOUT,DTOUT,DIRUT,ORTX,ORMAX,I,CNT
- +2 ;!'$O(ORDOSE("PI",0))
- IF $GET(ORCAT)'="O"
- DO CLEARWP
- QUIT
- +3 if $GET(ORENEW)
- QUIT
- SET I=0
- SET ORMAX=57
- +4 IF $GET(OREDIT)!$GET(OREWRITE)
- IF $ORDER(^TMP("ORWORD",$JOB,PROMPT,INST,0))
- KILL ORDOSE("PI")
- SET I=0
- FOR
- SET I=$ORDER(^TMP("ORWORD",$JOB,PROMPT,INST,I))
- if I<1
- QUIT
- SET ORDOSE("PI",I)=$GET(^(I,0))
- +5 IF '$ORDER(ORDOSE("PI",0))
- DO CLEARWP
- QUIT
- +6 FOR
- SET I=$ORDER(ORDOSE("PI",I))
- if I'>0
- QUIT
- SET X=ORDOSE("PI",I)
- DO TXT^ORCHTAB
- +7 SET DIR(0)="YA"
- SET DIR("A")="Include Patient Instructions in Sig? "
- +8 SET DIR("?")="Enter NO if you do not want these instructions included in the sig for this order"
- SET DIR("B")=$SELECT($DATA(^TMP("ORWORD",$JOB,PROMPT)):"YES",1:"NO")
- +9 WRITE !
- SET I=0
- FOR
- SET I=$ORDER(ORTX(I))
- if I'>0
- QUIT
- WRITE !,$SELECT(I=1:"Patient Instructions: ",1:" ")_ORTX(I)
- +10 DO ^DIR
- IF $DATA(DUOUT)!$DATA(DTOUT)
- SET ORQUIT=1
- QUIT
- +11 ;save text
- IF Y
- Begin DoDot:1
- +12 KILL ^TMP("ORWORD",$JOB,PROMPT,INST)
- SET CNT=0
- +13 SET I=0
- FOR
- SET I=$ORDER(ORDOSE("PI",I))
- if I'>0
- QUIT
- SET ^TMP("ORWORD",$JOB,PROMPT,INST,I,0)=ORDOSE("PI",I)
- SET CNT=CNT+1
- +14 SET ^TMP("ORWORD",$JOB,PROMPT,INST,0)="^^"_CNT_U_CNT_U_DT_U
- +15 SET ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"","_$JOB_","_PROMPT_","_INST_")"
- End DoDot:1
- QUIT
- +16 IF Y'>0
- KILL ORDIALOG(PROMPT,INST),^TMP("ORWORD",$JOB,PROMPT,INST)
- +17 QUIT
- +18 ;
- CLEARWP ; -- Clear INST of wp field PROMPT
- +1 KILL ORDIALOG(PROMPT,INST),^TMP("ORWORD",$JOB,PROMPT,INST)
- +2 QUIT