- ORCDPS3 ;SLC/MKB - Pharmacy dialog utilities ;Jan 11, 2022@09:03:58
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,134,158,149,190,277,243,289,317,350,405**;Dec 17, 1997;Build 211
- ;
- ;Reference to SCNEW^PSOCP supported by IA #2534
- ;Reference to DIS^DGRPDB supported by IA #700
- ;Reference to ^PSJORPOE supported by IA #3167
- ;
- START ; -- Start Date entry action
- S $P(ORDIALOG(PROMPT,0),":",3)=$S($G(ORCAT)="I":"ETRX",1:"EX")
- I $G(ORCAT)'="I" K ORSD K:$G(ORENEW)!$G(OREWRITE)!$D(OREDIT) ORDIALOG(PROMPT,INST) ;Inpt only
- Q
- ;
- ADMIN ; -- Return default admin time for order in ORSD
- ; Called from EXDOSE^ORCDPS2
- Q:$D(ORSD) Q:$G(ORCAT)'="I" ;inpt only
- N PSOI,PSIFN,SCH,CNJ,ORI,ORX
- S PSOI=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
- S PSIFN=$S($G(ORENEW):$G(^OR(100,+$G(ORIFN),4)),1:"")
- S SCH=$$PTR^ORCD("OR GTX SCHEDULE"),CNJ=$$PTR^ORCD("OR GTX AND/THEN"),ORX=""
- S ORI=0 F S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI<1 S ORX=ORX_$S($L(ORX):U,1:"")_$G(ORDIALOG(CNJ,ORI))_";"_$G(ORDIALOG(SCH,ORI))
- S ORSD=$$FIRST(+ORVP,+$G(ORWARD),PSOI,ORX,PSIFN,"")
- S:$P(ORSD,U)="NEXT" ORSD="NEXTA^"_$P(ORSD,U,2,99)
- Q
- ;
- FIRST(DFN,WARD,OI,DATA,ORDER,ADMIN) ; -- Return expected first admin time of order
- N CNT,ORCNT,ORI,J,ORZ,Y,SCH,ORX,TNUM
- I '$G(DFN)!'$G(OI) Q ""
- S ORCNT=0 F ORI=1:1:$L(DATA,"^") S ORZ=$P(DATA,U,ORI) D Q:$E(ORZ)="T"
- .S TNUM=$$NUMCHAR(ORZ,";") Q:TNUM=0
- .F CNT=1:1:TNUM D
- .. S SCH=$P(ORZ,";",CNT+1) Q:'$L(SCH) S ORCNT=ORCNT+1
- .. I ORCNT>1 S ADMIN=""
- .. S ORX(ORCNT)=$$STARTSTP^PSJORPOE(DFN,SCH,OI,WARD,$G(ORDER),$G(ADMIN))
- S Y=9999999,J=0
- F ORI=1:1:ORCNT S ORZ=$P(ORX(ORI),U,4) I ORZ<Y S Y=ORZ,J=ORI ;earliest
- S Y=$S(J:ORX(J),1:"")
- Q Y
- ;
- NUMCHAR(STRING,SUB) ;
- N CNT,RESULT
- S RESULT=0
- F CNT=1:1:$L(STRING) I $E(STRING,CNT)=SUB S RESULT=RESULT+1
- Q RESULT
- ;
- NOW ; -- First dose now?
- N X,Y,DIR,SCH
- K ^TMP($J,"ORCDPS3 NOW")
- ;DJE/VM *317 added check on ORIVTYPE. Don't require dosage for intermittent IVs
- I $G(ORCAT)="O"!(('$D(ORSD))&($G(ORIVTYPE)'="I"))!$L($G(OREVENT))!$G(ORENEW) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
- D AP^PSS51P1("PSJ",,,,"ORCDPS3 NOW")
- ; ask on Copy? Change?
- S X=$$PTR^ORCD("OR GTX SCHEDULE"),Y=+$O(ORDIALOG(X,0))
- S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^TMP($J,"ORCDPS3 NOW","APPSJ",SCH,0)) ;1st one
- ;S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^PS(51.1,"APPSJ",SCH,0)) ;1st one
- I $P($G(^TMP($J,"ORCDPS3 NOW",Y,5)),"^")="O"!(Y<1) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
- ;I $P($G(^PS(51.1,Y,0)),U,5)="O"!(Y<1) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
- ; other conditions?
- S DIR(0)="YA",DIR("A")="Give additional dose NOW? "
- S DIR("B")=$S($G(ORDIALOG(PROMPT,INST)):"YES",1:"NO")
- I $G(ORINPT),$P(ORSD,U,4) S DIR("A",1)="Next scheduled administration time: "_$$FMTE^XLFDT($P(ORSD,U,4))
- S DIR("?")="Enter YES if you want a dose given now in addition to the regular administration times for this schedule and ward."
- D ^DIR S:$D(DTOUT)!$D(DUOUT) ORQUIT=1
- I $G(ORQUIT)!(Y'>0) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
- S ORDIALOG(PROMPT,INST)=1 I $G(ORCOMPLX) D
- . W $C(7),!," >> First Dose NOW is in addition to those already entered. <<"
- . W !," >> Please adjust the duration of the first one, if necessary. <<"
- K ^TMP($J,"ORCDPS3 NOW")
- Q
- ;
- DEFSTRT ; -- Returns default start date/time in Y
- ; Expects PROMPT,INST,ORDIALOG,ORSD to be defined
- ;
- Q:$G(ORCAT)="O" Q:$G(ORTYPE)="Z" ;skip if outpt or editor
- N LAST,STRT,DUR,D1,D2,OFF,F1,F2,UNT,Y1,Y2,I,J K Y
- S LAST=+$O(ORDIALOG(+$$PTR^ORCD("OR GTX INSTRUCTIONS"),INST),-1)
- S STRT=$G(ORDIALOG(PROMPT,LAST))
- I LAST'>0!'$L(STRT) S:$L($P($G(ORSD),U)) Y=$P(ORSD,U) Q ;first inst
- S DUR=$G(ORDIALOG(+$$PTR^ORCD("OR GTX DURATION"),LAST))
- I +DUR'>0 S Y=STRT Q ;no duration = same start
- S DUR=$$FMDUR(DUR) I STRT D Q ;FM date/time, so just add
- . N X,%DT S %DT="TX",X=STRT_"+"_DUR D ^%DT
- . I Y'>0 S Y=STRT ;error
- S D1=+DUR,D2=$P(DUR,D1,2) S:(STRT="NEXTA")!(STRT="CLOSEST") STRT="NOW"
- S OFF=$P(STRT,"+",2) I '$L(OFF) S Y=STRT_"+"_DUR Q ;no prev offset
- S F1=+OFF,F2=$P(OFF,F1,2),UNT=F2,Y=STRT
- I D2=F2 S Y=$P(STRT,"+")_"+"_(D1+F1)_UNT Q ;same units
- F I="S","'","H","D","W","M" I (F2=I)!(D2=I) S UNT=I D Q
- . S:D2=UNT Y1=D1,X1=F1,X2=F2 ; Y1=# in UNT
- . S:F2=UNT Y1=F1,X1=D1,X2=D2 ; X1=# in other units X2
- . F J=1:1 S Z=$T(CONV+J) Q:Z["ZZZZ" I $P(Z,";",3,4)=(X2_";"_UNT) S Y2=+$P(Z,";",5) Q
- . S Y=$P(STRT,"+")_"+"_(Y1+$S(Y2:Y2*X1,1:0))_UNT
- Q
- ;
- FMDUR(X) ; -- convert '# DAYS' to #D
- N X1,X2,Y I +X'>0 Q ""
- S X1=+X,X2=$P(X," ",2) S:'$L(X2) X2="DAYS"
- S Y=X1_$S("MINUTES"[X2:"'",1:$E(X2))
- Q Y
- ;
- CONV ;;unit;unit;factor
- ;;';S;60
- ;;H;';60
- ;;H;S;3600
- ;;D;H;24
- ;;D;';1440
- ;;D;S;86400
- ;;W;D;7
- ;;W;H;168
- ;;W;';10080
- ;;W;S;604800
- ;;M;W;4
- ;;M;D;30
- ;;M;H;720
- ;;M;';43200
- ;;M;S;2592000
- ;;ZZZZ
- ;
- ;
- ASKTITR() ; Returns 1 or 0, if Titration prompt should be asked
- ;
- N ORCONJ,ORI,ORRET
- ;
- S ORRET=0
- S ORCONJ=$$PTR^ORCDPS("AND/THEN")
- ;
- S ORI=0
- F S ORI=$O(ORDIALOG(ORCONJ,ORI)) Q:'ORI!(ORRET) D
- . I $G(ORDIALOG(ORCONJ,ORI))="T" S ORRET=1
- ;
- Q ORRET
- ;
- ASKDUR() ; -- Returns 1 or 0, if Duration prompt should be asked
- K ^TMP($J,"ORCDPS3 ASKDUR")
- N X,Y I '$G(ORCOMPLX) K ORDIALOG(PROMPT,INST) Q 0
- S Y=1 G:'$L($G(ORSCH)) ADQ ;no schedule
- D AP^PSS51P1("PSJ",,,,"ORCDPS3 ASKDUR")
- S X=+$O(^TMP($J,"ORCDPS3 ASKDUR","APPSJ",ORSCH,"")) G:X'>0 ADQ
- ;S X=+$O(^PS(51.1,"APPSJ",ORSCH,0)) G:X'>0 ADQ
- S:^TMP($J,"ORCDPS3 ASKDUR",X,5)="O" Y=0
- ;S:$P($G(^PS(51.1,X,0)),U,5)="O" Y=0
- ADQ ;
- K ^TMP($J,"ORCDPS3 ASKDUR")
- Q Y
- ;
- CKDUR(X) ; -- Returns validated form of duration X, or null if invalid
- N X1,X2,Y,Z S Y=""
- S X1=+$G(X),X2=$P($G(X),X1,2) I X1'>0 Q ""
- S X2=$$UP^XLFSTR(X2),X2=$$STRIP^XLFSTR(X2," ") S:'$L(X2) X2="DAYS"
- F Z="MONTHS^&MONTHS&MONS","WEEKS^&WEEKS&WKS","DAYS^&DAYS&DYS","HOURS^&HOURS&HRS","MINUTES^&MINUTES&MINS'","SECONDS^&SECONDS&SECS" I $P(Z,U,2)[("&"_X2) S Y=$P(Z,U) Q
- S:$L(Y) Y=X1_" "_$S(X1=1:$E(Y,1,$L(Y)-1),1:Y) ;strip trailing 's'
- Q Y
- ;
- DUR ; -- Process duration [from P-S Action]
- N X S X=$G(ORDIALOG(PROMPT,ORI)),X=$$CKDUR(X)
- I '$L(X) K DONE W $C(7),!,ORDIALOG(PROMPT,"?"),! Q
- S ORDIALOG(PROMPT,ORI)=X D:$G(ORESET)'=X CHANGED^ORCDPS1("QUANTITY")
- Q
- ;
- TEST(START,DURTN) ; -- test DEFSTRT
- N INST,ORSD,ORDIALOG,PROMPT
- S ORDIALOG(136,1)="",INST=2,ORSD="NOW",PROMPT=6
- S:$L($G(START)) ORDIALOG(6,1)=START S:$G(DURTN) ORDIALOG(153,1)=DURTN
- D DEFSTRT W !,Y
- Q
- ;
- SC ; -- Dialog validation, to ask SC questions
- ; Expects ORIFN, ORDA, and ORDER
- ;
- Q:'$L($T(SCNEW^PSOCP)) Q:'$G(ORIFN) Q:'$G(ORDA)
- Q:$P($G(^OR(100,ORIFN,0)),U,12)'="O" Q:$P($G(^(8,ORDA,0)),U,2)'="NW" Q:$P($G(^(0)),U,15)=""
- ;
- N OR3,ORDRUG,PSIFN,ORX,I,J,DIE,DR,DA,X,Y,DTOUT,ORIGVIEW,DFN
- S OR3=$G(^OR(100,ORIFN,3)),X=$P(OR3,U,11) I X>2 Q ;new, edit, or renew
- I X S Y=$P(OR3,U,5),PSIFN=$G(^OR(100,Y,4)) ;get PS# if edit/renewal
- S ORDRUG=$$VALUE^ORCSAVE2(ORIFN,"DRUG")
- D SCNEW^PSOCP(.ORX,+ORVP,ORDRUG,$G(PSIFN)) Q:'$D(ORX)
- S DIE="^OR(100,",DA=ORIFN,DR="",J=0
- F I="SC","MST","AO","IR","EC","HNC","CV" S J=J+1 I $D(ORX(I)) S X=ORX(I) S:I="CV"&(X="") X=1 S DR=DR_";5"_J_"R"_$S($L(X):"//"_$S(X:"YES",1:"NO"),1:"")
- S:$E(DR)=";" DR=$E(DR,2,999) Q:'$L(DR) S ORIGVIEW=1
- I $D(ORX("SC")) S DFN=+ORVP D DIS^DGRPDB ;show current SC data
- W !!,"Is "_$$ORDITEM^ORCACT(ORDER)_" for treatment related to:"
- D ^DIE S:$D(DTOUT)!$D(Y) ORQUIT=1
- Q
- PRI ; Validate Priority for Outpatient orders
- I X?1"D".E!(X?1"d".E) K X
- Q
- ;
- IND ;returns indications for use
- Q:'$D(^TMP("PSJIND",$J))
- N CNT,I,TXT S (CNT,I)=0
- F S I=$O(^TMP("PSJIND",$J,I)) Q:'I D
- .S TXT=$P(^(I),"^"),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=TXT
- S:CNT ORDIALOG(PROMPT,"LIST")=CNT
- Q
- ;
- XHELP ; -- list indications for use if defined
- N NUM,I,CNT S (I,CNT)=0
- S NUM=$G(ORDIALOG(PROMPT,"LIST")) Q:'NUM
- W !,"Choose from:"
- F S I=$O(ORDIALOG(PROMPT,"LIST",I)) Q:'I D
- . W !,?5,I_" "_$P(ORDIALOG(PROMPT,"LIST",I),U)
- Q
- ;
- DFIND ; -- Get default indication for use
- Q
- ;
- INDIT ;
- I X,$D(ORDIALOG(PROMPT,"LIST",X)) Q
- I $E(X)=0!(X?1P.E)!(X>$G(ORDIALOG(PROMPT,"LIST"))) K X Q
- K:$L(X)>40!($L(X)<3) X
- Q
- ;
- PARKCK ;
- S X=$$UPPER^ORWDPS32(X)
- I X="M"!(X="W") Q
- N BX,PK S BX=X
- S PK=$$GET^XPAR("DIV^SYS^PKG","PSO PARK ON"),X=BX
- I 'PK,X="P" K X W !,"PARK is disabled at the site, PARK is not a choice."
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDPS3 8439 printed Jan 18, 2025@03:29:21 Page 2
- ORCDPS3 ;SLC/MKB - Pharmacy dialog utilities ;Jan 11, 2022@09:03:58
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,134,158,149,190,277,243,289,317,350,405**;Dec 17, 1997;Build 211
- +2 ;
- +3 ;Reference to SCNEW^PSOCP supported by IA #2534
- +4 ;Reference to DIS^DGRPDB supported by IA #700
- +5 ;Reference to ^PSJORPOE supported by IA #3167
- +6 ;
- START ; -- Start Date entry action
- +1 SET $PIECE(ORDIALOG(PROMPT,0),":",3)=$SELECT($GET(ORCAT)="I":"ETRX",1:"EX")
- +2 ;Inpt only
- IF $GET(ORCAT)'="I"
- KILL ORSD
- if $GET(ORENEW)!$GET(OREWRITE)!$DATA(OREDIT)
- KILL ORDIALOG(PROMPT,INST)
- +3 QUIT
- +4 ;
- ADMIN ; -- Return default admin time for order in ORSD
- +1 ; Called from EXDOSE^ORCDPS2
- +2 ;inpt only
- if $DATA(ORSD)
- QUIT
- if $GET(ORCAT)'="I"
- QUIT
- +3 NEW PSOI,PSIFN,SCH,CNJ,ORI,ORX
- +4 SET PSOI=+$PIECE($GET(^ORD(101.43,+$GET(OROI),0)),U,2)
- +5 SET PSIFN=$SELECT($GET(ORENEW):$GET(^OR(100,+$GET(ORIFN),4)),1:"")
- +6 SET SCH=$$PTR^ORCD("OR GTX SCHEDULE")
- SET CNJ=$$PTR^ORCD("OR GTX AND/THEN")
- SET ORX=""
- +7 SET ORI=0
- FOR
- SET ORI=$ORDER(ORDIALOG(PROMPT,ORI))
- if ORI<1
- QUIT
- SET ORX=ORX_$SELECT($LENGTH(ORX):U,1:"")_$GET(ORDIALOG(CNJ,ORI))_";"_$GET(ORDIALOG(SCH,ORI))
- +8 SET ORSD=$$FIRST(+ORVP,+$GET(ORWARD),PSOI,ORX,PSIFN,"")
- +9 if $PIECE(ORSD,U)="NEXT"
- SET ORSD="NEXTA^"_$PIECE(ORSD,U,2,99)
- +10 QUIT
- +11 ;
- FIRST(DFN,WARD,OI,DATA,ORDER,ADMIN) ; -- Return expected first admin time of order
- +1 NEW CNT,ORCNT,ORI,J,ORZ,Y,SCH,ORX,TNUM
- +2 IF '$GET(DFN)!'$GET(OI)
- QUIT ""
- +3 SET ORCNT=0
- FOR ORI=1:1:$LENGTH(DATA,"^")
- SET ORZ=$PIECE(DATA,U,ORI)
- Begin DoDot:1
- +4 SET TNUM=$$NUMCHAR(ORZ,";")
- if TNUM=0
- QUIT
- +5 FOR CNT=1:1:TNUM
- Begin DoDot:2
- +6 SET SCH=$PIECE(ORZ,";",CNT+1)
- if '$LENGTH(SCH)
- QUIT
- SET ORCNT=ORCNT+1
- +7 IF ORCNT>1
- SET ADMIN=""
- +8 SET ORX(ORCNT)=$$STARTSTP^PSJORPOE(DFN,SCH,OI,WARD,$GET(ORDER),$GET(ADMIN))
- End DoDot:2
- End DoDot:1
- if $EXTRACT(ORZ)="T"
- QUIT
- +9 SET Y=9999999
- SET J=0
- +10 ;earliest
- FOR ORI=1:1:ORCNT
- SET ORZ=$PIECE(ORX(ORI),U,4)
- IF ORZ<Y
- SET Y=ORZ
- SET J=ORI
- +11 SET Y=$SELECT(J:ORX(J),1:"")
- +12 QUIT Y
- +13 ;
- NUMCHAR(STRING,SUB) ;
- +1 NEW CNT,RESULT
- +2 SET RESULT=0
- +3 FOR CNT=1:1:$LENGTH(STRING)
- IF $EXTRACT(STRING,CNT)=SUB
- SET RESULT=RESULT+1
- +4 QUIT RESULT
- +5 ;
- NOW ; -- First dose now?
- +1 NEW X,Y,DIR,SCH
- +2 KILL ^TMP($JOB,"ORCDPS3 NOW")
- +3 ;DJE/VM *317 added check on ORIVTYPE. Don't require dosage for intermittent IVs
- +4 IF $GET(ORCAT)="O"!(('$DATA(ORSD))&($GET(ORIVTYPE)'="I"))!$LENGTH($GET(OREVENT))!$GET(ORENEW)
- KILL ORDIALOG(PROMPT,INST),^TMP($JOB,"ORCDPS3 NOW")
- QUIT
- +5 DO AP^PSS51P1("PSJ",,,,"ORCDPS3 NOW")
- +6 ; ask on Copy? Change?
- +7 SET X=$$PTR^ORCD("OR GTX SCHEDULE")
- SET Y=+$ORDER(ORDIALOG(X,0))
- +8 ;1st one
- SET SCH=$GET(ORDIALOG(X,Y))
- SET Y=+$ORDER(^TMP($JOB,"ORCDPS3 NOW","APPSJ",SCH,0))
- +9 ;S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^PS(51.1,"APPSJ",SCH,0)) ;1st one
- +10 IF $PIECE($GET(^TMP($JOB,"ORCDPS3 NOW",Y,5)),"^")="O"!(Y<1)
- KILL ORDIALOG(PROMPT,INST),^TMP($JOB,"ORCDPS3 NOW")
- QUIT
- +11 ;I $P($G(^PS(51.1,Y,0)),U,5)="O"!(Y<1) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
- +12 ; other conditions?
- +13 SET DIR(0)="YA"
- SET DIR("A")="Give additional dose NOW? "
- +14 SET DIR("B")=$SELECT($GET(ORDIALOG(PROMPT,INST)):"YES",1:"NO")
- +15 IF $GET(ORINPT)
- IF $PIECE(ORSD,U,4)
- SET DIR("A",1)="Next scheduled administration time: "_$$FMTE^XLFDT($PIECE(ORSD,U,4))
- +16 SET DIR("?")="Enter YES if you want a dose given now in addition to the regular administration times for this schedule and ward."
- +17 DO ^DIR
- if $DATA(DTOUT)!$DATA(DUOUT)
- SET ORQUIT=1
- +18 IF $GET(ORQUIT)!(Y'>0)
- KILL ORDIALOG(PROMPT,INST),^TMP($JOB,"ORCDPS3 NOW")
- QUIT
- +19 SET ORDIALOG(PROMPT,INST)=1
- IF $GET(ORCOMPLX)
- Begin DoDot:1
- +20 WRITE $CHAR(7),!," >> First Dose NOW is in addition to those already entered. <<"
- +21 WRITE !," >> Please adjust the duration of the first one, if necessary. <<"
- End DoDot:1
- +22 KILL ^TMP($JOB,"ORCDPS3 NOW")
- +23 QUIT
- +24 ;
- DEFSTRT ; -- Returns default start date/time in Y
- +1 ; Expects PROMPT,INST,ORDIALOG,ORSD to be defined
- +2 ;
- +3 ;skip if outpt or editor
- if $GET(ORCAT)="O"
- QUIT
- if $GET(ORTYPE)="Z"
- QUIT
- +4 NEW LAST,STRT,DUR,D1,D2,OFF,F1,F2,UNT,Y1,Y2,I,J
- KILL Y
- +5 SET LAST=+$ORDER(ORDIALOG(+$$PTR^ORCD("OR GTX INSTRUCTIONS"),INST),-1)
- +6 SET STRT=$GET(ORDIALOG(PROMPT,LAST))
- +7 ;first inst
- IF LAST'>0!'$LENGTH(STRT)
- if $LENGTH($PIECE($GET(ORSD),U))
- SET Y=$PIECE(ORSD,U)
- QUIT
- +8 SET DUR=$GET(ORDIALOG(+$$PTR^ORCD("OR GTX DURATION"),LAST))
- +9 ;no duration = same start
- IF +DUR'>0
- SET Y=STRT
- QUIT
- +10 ;FM date/time, so just add
- SET DUR=$$FMDUR(DUR)
- IF STRT
- Begin DoDot:1
- +11 NEW X,%DT
- SET %DT="TX"
- SET X=STRT_"+"_DUR
- DO ^%DT
- +12 ;error
- IF Y'>0
- SET Y=STRT
- End DoDot:1
- QUIT
- +13 SET D1=+DUR
- SET D2=$PIECE(DUR,D1,2)
- if (STRT="NEXTA")!(STRT="CLOSEST")
- SET STRT="NOW"
- +14 ;no prev offset
- SET OFF=$PIECE(STRT,"+",2)
- IF '$LENGTH(OFF)
- SET Y=STRT_"+"_DUR
- QUIT
- +15 SET F1=+OFF
- SET F2=$PIECE(OFF,F1,2)
- SET UNT=F2
- SET Y=STRT
- +16 ;same units
- IF D2=F2
- SET Y=$PIECE(STRT,"+")_"+"_(D1+F1)_UNT
- QUIT
- +17 FOR I="S","'","H","D","W","M"
- IF (F2=I)!(D2=I)
- SET UNT=I
- Begin DoDot:1
- +18 ; Y1=# in UNT
- if D2=UNT
- SET Y1=D1
- SET X1=F1
- SET X2=F2
- +19 ; X1=# in other units X2
- if F2=UNT
- SET Y1=F1
- SET X1=D1
- SET X2=D2
- +20 FOR J=1:1
- SET Z=$TEXT(CONV+J)
- if Z["ZZZZ"
- QUIT
- IF $PIECE(Z,";",3,4)=(X2_";"_UNT)
- SET Y2=+$PIECE(Z,";",5)
- QUIT
- +21 SET Y=$PIECE(STRT,"+")_"+"_(Y1+$SELECT(Y2:Y2*X1,1:0))_UNT
- End DoDot:1
- QUIT
- +22 QUIT
- +23 ;
- FMDUR(X) ; -- convert '# DAYS' to #D
- +1 NEW X1,X2,Y
- IF +X'>0
- QUIT ""
- +2 SET X1=+X
- SET X2=$PIECE(X," ",2)
- if '$LENGTH(X2)
- SET X2="DAYS"
- +3 SET Y=X1_$SELECT("MINUTES"[X2:"'",1:$EXTRACT(X2))
- +4 QUIT Y
- +5 ;
- CONV ;;unit;unit;factor
- +1 ;;';S;60
- +2 ;;H;';60
- +3 ;;H;S;3600
- +4 ;;D;H;24
- +5 ;;D;';1440
- +6 ;;D;S;86400
- +7 ;;W;D;7
- +8 ;;W;H;168
- +9 ;;W;';10080
- +10 ;;W;S;604800
- +11 ;;M;W;4
- +12 ;;M;D;30
- +13 ;;M;H;720
- +14 ;;M;';43200
- +15 ;;M;S;2592000
- +16 ;;ZZZZ
- +17 ;
- +18 ;
- ASKTITR() ; Returns 1 or 0, if Titration prompt should be asked
- +1 ;
- +2 NEW ORCONJ,ORI,ORRET
- +3 ;
- +4 SET ORRET=0
- +5 SET ORCONJ=$$PTR^ORCDPS("AND/THEN")
- +6 ;
- +7 SET ORI=0
- +8 FOR
- SET ORI=$ORDER(ORDIALOG(ORCONJ,ORI))
- if 'ORI!(ORRET)
- QUIT
- Begin DoDot:1
- +9 IF $GET(ORDIALOG(ORCONJ,ORI))="T"
- SET ORRET=1
- End DoDot:1
- +10 ;
- +11 QUIT ORRET
- +12 ;
- ASKDUR() ; -- Returns 1 or 0, if Duration prompt should be asked
- +1 KILL ^TMP($JOB,"ORCDPS3 ASKDUR")
- +2 NEW X,Y
- IF '$GET(ORCOMPLX)
- KILL ORDIALOG(PROMPT,INST)
- QUIT 0
- +3 ;no schedule
- SET Y=1
- if '$LENGTH($GET(ORSCH))
- GOTO ADQ
- +4 DO AP^PSS51P1("PSJ",,,,"ORCDPS3 ASKDUR")
- +5 SET X=+$ORDER(^TMP($JOB,"ORCDPS3 ASKDUR","APPSJ",ORSCH,""))
- if X'>0
- GOTO ADQ
- +6 ;S X=+$O(^PS(51.1,"APPSJ",ORSCH,0)) G:X'>0 ADQ
- +7 if ^TMP($JOB,"ORCDPS3 ASKDUR",X,5)="O"
- SET Y=0
- +8 ;S:$P($G(^PS(51.1,X,0)),U,5)="O" Y=0
- ADQ ;
- +1 KILL ^TMP($JOB,"ORCDPS3 ASKDUR")
- +2 QUIT Y
- +3 ;
- CKDUR(X) ; -- Returns validated form of duration X, or null if invalid
- +1 NEW X1,X2,Y,Z
- SET Y=""
- +2 SET X1=+$GET(X)
- SET X2=$PIECE($GET(X),X1,2)
- IF X1'>0
- QUIT ""
- +3 SET X2=$$UP^XLFSTR(X2)
- SET X2=$$STRIP^XLFSTR(X2," ")
- if '$LENGTH(X2)
- SET X2="DAYS"
- +4 FOR Z="MONTHS^&MONTHS&MONS","WEEKS^&WEEKS&WKS","DAYS^&DAYS&DYS","HOURS^&HOURS&HRS","MINUTES^&MINUTES&MINS'","SECONDS^&SECONDS&SECS"
- IF $PIECE(Z,U,2)[("&"_X2)
- SET Y=$PIECE(Z,U)
- QUIT
- +5 ;strip trailing 's'
- if $LENGTH(Y)
- SET Y=X1_" "_$SELECT(X1=1:$EXTRACT(Y,1,$LENGTH(Y)-1),1:Y)
- +6 QUIT Y
- +7 ;
- DUR ; -- Process duration [from P-S Action]
- +1 NEW X
- SET X=$GET(ORDIALOG(PROMPT,ORI))
- SET X=$$CKDUR(X)
- +2 IF '$LENGTH(X)
- KILL DONE
- WRITE $CHAR(7),!,ORDIALOG(PROMPT,"?"),!
- QUIT
- +3 SET ORDIALOG(PROMPT,ORI)=X
- if $GET(ORESET)'=X
- DO CHANGED^ORCDPS1("QUANTITY")
- +4 QUIT
- +5 ;
- TEST(START,DURTN) ; -- test DEFSTRT
- +1 NEW INST,ORSD,ORDIALOG,PROMPT
- +2 SET ORDIALOG(136,1)=""
- SET INST=2
- SET ORSD="NOW"
- SET PROMPT=6
- +3 if $LENGTH($GET(START))
- SET ORDIALOG(6,1)=START
- if $GET(DURTN)
- SET ORDIALOG(153,1)=DURTN
- +4 DO DEFSTRT
- WRITE !,Y
- +5 QUIT
- +6 ;
- SC ; -- Dialog validation, to ask SC questions
- +1 ; Expects ORIFN, ORDA, and ORDER
- +2 ;
- +3 if '$LENGTH($TEXT(SCNEW^PSOCP))
- QUIT
- if '$GET(ORIFN)
- QUIT
- if '$GET(ORDA)
- QUIT
- +4 if $PIECE($GET(^OR(100,ORIFN,0)),U,12)'="O"
- QUIT
- if $PIECE($GET(^(8,ORDA,0)),U,2)'="NW"
- QUIT
- if $PIECE($GET(^(0)),U,15)=""
- QUIT
- +5 ;
- +6 NEW OR3,ORDRUG,PSIFN,ORX,I,J,DIE,DR,DA,X,Y,DTOUT,ORIGVIEW,DFN
- +7 ;new, edit, or renew
- SET OR3=$GET(^OR(100,ORIFN,3))
- SET X=$PIECE(OR3,U,11)
- IF X>2
- QUIT
- +8 ;get PS# if edit/renewal
- IF X
- SET Y=$PIECE(OR3,U,5)
- SET PSIFN=$GET(^OR(100,Y,4))
- +9 SET ORDRUG=$$VALUE^ORCSAVE2(ORIFN,"DRUG")
- +10 DO SCNEW^PSOCP(.ORX,+ORVP,ORDRUG,$GET(PSIFN))
- if '$DATA(ORX)
- QUIT
- +11 SET DIE="^OR(100,"
- SET DA=ORIFN
- SET DR=""
- SET J=0
- +12 FOR I="SC","MST","AO","IR","EC","HNC","CV"
- SET J=J+1
- IF $DATA(ORX(I))
- SET X=ORX(I)
- if I="CV"&(X="")
- SET X=1
- SET DR=DR_";5"_J_"R"_$SELECT($LENGTH(X):"//"_$SELECT(X:"YES",1:"NO"),1:"")
- +13 if $EXTRACT(DR)=";"
- SET DR=$EXTRACT(DR,2,999)
- if '$LENGTH(DR)
- QUIT
- SET ORIGVIEW=1
- +14 ;show current SC data
- IF $DATA(ORX("SC"))
- SET DFN=+ORVP
- DO DIS^DGRPDB
- +15 WRITE !!,"Is "_$$ORDITEM^ORCACT(ORDER)_" for treatment related to:"
- +16 DO ^DIE
- if $DATA(DTOUT)!$DATA(Y)
- SET ORQUIT=1
- +17 QUIT
- PRI ; Validate Priority for Outpatient orders
- +1 IF X?1"D".E!(X?1"d".E)
- KILL X
- +2 QUIT
- +3 ;
- IND ;returns indications for use
- +1 if '$DATA(^TMP("PSJIND",$JOB))
- QUIT
- +2 NEW CNT,I,TXT
- SET (CNT,I)=0
- +3 FOR
- SET I=$ORDER(^TMP("PSJIND",$JOB,I))
- if 'I
- QUIT
- Begin DoDot:1
- +4 SET TXT=$PIECE(^(I),"^")
- SET CNT=CNT+1
- SET ORDIALOG(PROMPT,"LIST",CNT)=TXT
- End DoDot:1
- +5 if CNT
- SET ORDIALOG(PROMPT,"LIST")=CNT
- +6 QUIT
- +7 ;
- XHELP ; -- list indications for use if defined
- +1 NEW NUM,I,CNT
- SET (I,CNT)=0
- +2 SET NUM=$GET(ORDIALOG(PROMPT,"LIST"))
- if 'NUM
- QUIT
- +3 WRITE !,"Choose from:"
- +4 FOR
- SET I=$ORDER(ORDIALOG(PROMPT,"LIST",I))
- if 'I
- QUIT
- Begin DoDot:1
- +5 WRITE !,?5,I_" "_$PIECE(ORDIALOG(PROMPT,"LIST",I),U)
- End DoDot:1
- +6 QUIT
- +7 ;
- DFIND ; -- Get default indication for use
- +1 QUIT
- +2 ;
- INDIT ;
- +1 IF X
- IF $DATA(ORDIALOG(PROMPT,"LIST",X))
- QUIT
- +2 IF $EXTRACT(X)=0!(X?1P.E)!(X>$GET(ORDIALOG(PROMPT,"LIST")))
- KILL X
- QUIT
- +3 if $LENGTH(X)>40!($LENGTH(X)<3)
- KILL X
- +4 QUIT
- +5 ;
- PARKCK ;
- +1 SET X=$$UPPER^ORWDPS32(X)
- +2 IF X="M"!(X="W")
- QUIT
- +3 NEW BX,PK
- SET BX=X
- +4 SET PK=$$GET^XPAR("DIV^SYS^PKG","PSO PARK ON")
- SET X=BX
- +5 IF 'PK
- IF X="P"
- KILL X
- WRITE !,"PARK is disabled at the site, PARK is not a choice."
- +6 QUIT
- +7 ;