source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDPS2.m@ 949

ORCDPS2 ;SLC/MKB-Pharmacy dialog utilities ;07:24 AM  5 Apr 2001 [12/31/01 6:35pm]
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,125,131**;Dec 17, 1997
 ;
COMPLEX() ; -- Single or complex dose?
 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)="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 ; -- Get 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 ; -- enter here 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
 I $L(X)>60,'$D(ORDIALOG(PROMPT,"LIST","B",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
 Q
 ;
EXDOSE ; -- Dose 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":"",$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) ; -- Return ptr to prompt OR GTX X
 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
 ;
DOSE() ; -- Return 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 S Y=$$WORD($P(X0,"&",3))_" "_$P(X0,"&",4) ;u/d
 Q Y
 ;
WORD(X) ; -- Return 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() ; -- Return expansion of route
 N X,X0,Y S X=+$G(ORDIALOG(ORT,ORI)) Q:X'>0 ""
 S X0=$G(^PS(51.2,+X,0)),Y=""
 I ORCAT="I" S Y=" "_$S($L($P(X0,U,3)):$P(X0,U,3),1:$P(X0,U))
 I ORCAT="O" S Y=" "_$S($L(ORPREP):ORPREP_" ",1:"")_$S($L($P(X0,U,2)):$P(X0,U,2),1:$P(X0,U))
 Q Y
 ;
SCH() ; -- Return [outpatient] expansion of schedule
 N X,Y S X=$G(ORDIALOG(ORSCH,ORI))
 I $L(X),ORCAT="O" D SCH^PSSUTIL1(.X)
 S Y=$S($L(X):" "_X,1:"")
 Q Y
 ;
DUR() ; -- Return 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() ; -- Return conjuction
 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,X,PROMPT
 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)),X=$G(ORDIALOG(DOSE,ORI)) Q:'$L(X)
 . S:'X ORDIALOG(INSTR,ORI)=LDOSE_CONJ_" "_$S(STRG:STRG,1:$P(DRUG0,U))
 ; -build Sig/Text if not defined
 I '$D(ORDIALOG(+$$PTR("SIG"),1)) S PROMPT=INSTR D SIG
 Q
 ;
PI ; -- Include Patient 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")="YES"
 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