Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCDPS3

ORCDPS3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Reference to SCNEW^PSOCP supported by IA #2534
  1. ;Reference to DIS^DGRPDB supported by IA #700
  1. ;Reference to ^PSJORPOE supported by IA #3167
  1. ;
  1. START ; -- Start Date entry action
  1. S $P(ORDIALOG(PROMPT,0),":",3)=$S($G(ORCAT)="I":"ETRX",1:"EX")
  1. I $G(ORCAT)'="I" K ORSD K:$G(ORENEW)!$G(OREWRITE)!$D(OREDIT) ORDIALOG(PROMPT,INST) ;Inpt only
  1. Q
  1. ;
  1. ADMIN ; -- Return default admin time for order in ORSD
  1. ; Called from EXDOSE^ORCDPS2
  1. Q:$D(ORSD) Q:$G(ORCAT)'="I" ;inpt only
  1. N PSOI,PSIFN,SCH,CNJ,ORI,ORX
  1. S PSOI=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
  1. S PSIFN=$S($G(ORENEW):$G(^OR(100,+$G(ORIFN),4)),1:"")
  1. S SCH=$$PTR^ORCD("OR GTX SCHEDULE"),CNJ=$$PTR^ORCD("OR GTX AND/THEN"),ORX=""
  1. 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))
  1. S ORSD=$$FIRST(+ORVP,+$G(ORWARD),PSOI,ORX,PSIFN,"")
  1. S:$P(ORSD,U)="NEXT" ORSD="NEXTA^"_$P(ORSD,U,2,99)
  1. Q
  1. ;
  1. FIRST(DFN,WARD,OI,DATA,ORDER,ADMIN) ; -- Return expected first admin time of order
  1. N CNT,ORCNT,ORI,J,ORZ,Y,SCH,ORX,TNUM
  1. I '$G(DFN)!'$G(OI) Q ""
  1. S ORCNT=0 F ORI=1:1:$L(DATA,"^") S ORZ=$P(DATA,U,ORI) D Q:$E(ORZ)="T"
  1. .S TNUM=$$NUMCHAR(ORZ,";") Q:TNUM=0
  1. .F CNT=1:1:TNUM D
  1. .. S SCH=$P(ORZ,";",CNT+1) Q:'$L(SCH) S ORCNT=ORCNT+1
  1. .. I ORCNT>1 S ADMIN=""
  1. .. S ORX(ORCNT)=$$STARTSTP^PSJORPOE(DFN,SCH,OI,WARD,$G(ORDER),$G(ADMIN))
  1. S Y=9999999,J=0
  1. F ORI=1:1:ORCNT S ORZ=$P(ORX(ORI),U,4) I ORZ<Y S Y=ORZ,J=ORI ;earliest
  1. S Y=$S(J:ORX(J),1:"")
  1. Q Y
  1. ;
  1. NUMCHAR(STRING,SUB) ;
  1. N CNT,RESULT
  1. S RESULT=0
  1. F CNT=1:1:$L(STRING) I $E(STRING,CNT)=SUB S RESULT=RESULT+1
  1. Q RESULT
  1. ;
  1. NOW ; -- First dose now?
  1. N X,Y,DIR,SCH
  1. K ^TMP($J,"ORCDPS3 NOW")
  1. ;DJE/VM *317 added check on ORIVTYPE. Don't require dosage for intermittent IVs
  1. I $G(ORCAT)="O"!(('$D(ORSD))&($G(ORIVTYPE)'="I"))!$L($G(OREVENT))!$G(ORENEW) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
  1. D AP^PSS51P1("PSJ",,,,"ORCDPS3 NOW")
  1. ; ask on Copy? Change?
  1. S X=$$PTR^ORCD("OR GTX SCHEDULE"),Y=+$O(ORDIALOG(X,0))
  1. S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^TMP($J,"ORCDPS3 NOW","APPSJ",SCH,0)) ;1st one
  1. ;S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^PS(51.1,"APPSJ",SCH,0)) ;1st one
  1. I $P($G(^TMP($J,"ORCDPS3 NOW",Y,5)),"^")="O"!(Y<1) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
  1. ;I $P($G(^PS(51.1,Y,0)),U,5)="O"!(Y<1) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
  1. ; other conditions?
  1. S DIR(0)="YA",DIR("A")="Give additional dose NOW? "
  1. S DIR("B")=$S($G(ORDIALOG(PROMPT,INST)):"YES",1:"NO")
  1. I $G(ORINPT),$P(ORSD,U,4) S DIR("A",1)="Next scheduled administration time: "_$$FMTE^XLFDT($P(ORSD,U,4))
  1. S DIR("?")="Enter YES if you want a dose given now in addition to the regular administration times for this schedule and ward."
  1. D ^DIR S:$D(DTOUT)!$D(DUOUT) ORQUIT=1
  1. I $G(ORQUIT)!(Y'>0) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
  1. S ORDIALOG(PROMPT,INST)=1 I $G(ORCOMPLX) D
  1. . W $C(7),!," >> First Dose NOW is in addition to those already entered. <<"
  1. . W !," >> Please adjust the duration of the first one, if necessary. <<"
  1. K ^TMP($J,"ORCDPS3 NOW")
  1. Q
  1. ;
  1. DEFSTRT ; -- Returns default start date/time in Y
  1. ; Expects PROMPT,INST,ORDIALOG,ORSD to be defined
  1. ;
  1. Q:$G(ORCAT)="O" Q:$G(ORTYPE)="Z" ;skip if outpt or editor
  1. N LAST,STRT,DUR,D1,D2,OFF,F1,F2,UNT,Y1,Y2,I,J K Y
  1. S LAST=+$O(ORDIALOG(+$$PTR^ORCD("OR GTX INSTRUCTIONS"),INST),-1)
  1. S STRT=$G(ORDIALOG(PROMPT,LAST))
  1. I LAST'>0!'$L(STRT) S:$L($P($G(ORSD),U)) Y=$P(ORSD,U) Q ;first inst
  1. S DUR=$G(ORDIALOG(+$$PTR^ORCD("OR GTX DURATION"),LAST))
  1. I +DUR'>0 S Y=STRT Q ;no duration = same start
  1. S DUR=$$FMDUR(DUR) I STRT D Q ;FM date/time, so just add
  1. . N X,%DT S %DT="TX",X=STRT_"+"_DUR D ^%DT
  1. . I Y'>0 S Y=STRT ;error
  1. S D1=+DUR,D2=$P(DUR,D1,2) S:(STRT="NEXTA")!(STRT="CLOSEST") STRT="NOW"
  1. S OFF=$P(STRT,"+",2) I '$L(OFF) S Y=STRT_"+"_DUR Q ;no prev offset
  1. S F1=+OFF,F2=$P(OFF,F1,2),UNT=F2,Y=STRT
  1. I D2=F2 S Y=$P(STRT,"+")_"+"_(D1+F1)_UNT Q ;same units
  1. F I="S","'","H","D","W","M" I (F2=I)!(D2=I) S UNT=I D Q
  1. . S:D2=UNT Y1=D1,X1=F1,X2=F2 ; Y1=# in UNT
  1. . S:F2=UNT Y1=F1,X1=D1,X2=D2 ; X1=# in other units X2
  1. . 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
  1. . S Y=$P(STRT,"+")_"+"_(Y1+$S(Y2:Y2*X1,1:0))_UNT
  1. Q
  1. ;
  1. FMDUR(X) ; -- convert '# DAYS' to #D
  1. N X1,X2,Y I +X'>0 Q ""
  1. S X1=+X,X2=$P(X," ",2) S:'$L(X2) X2="DAYS"
  1. S Y=X1_$S("MINUTES"[X2:"'",1:$E(X2))
  1. Q Y
  1. ;
  1. CONV ;;unit;unit;factor
  1. ;;';S;60
  1. ;;H;';60
  1. ;;H;S;3600
  1. ;;D;H;24
  1. ;;D;';1440
  1. ;;D;S;86400
  1. ;;W;D;7
  1. ;;W;H;168
  1. ;;W;';10080
  1. ;;W;S;604800
  1. ;;M;W;4
  1. ;;M;D;30
  1. ;;M;H;720
  1. ;;M;';43200
  1. ;;M;S;2592000
  1. ;;ZZZZ
  1. ;
  1. ;
  1. ASKTITR() ; Returns 1 or 0, if Titration prompt should be asked
  1. ;
  1. N ORCONJ,ORI,ORRET
  1. ;
  1. S ORRET=0
  1. S ORCONJ=$$PTR^ORCDPS("AND/THEN")
  1. ;
  1. S ORI=0
  1. F S ORI=$O(ORDIALOG(ORCONJ,ORI)) Q:'ORI!(ORRET) D
  1. . I $G(ORDIALOG(ORCONJ,ORI))="T" S ORRET=1
  1. ;
  1. Q ORRET
  1. ;
  1. ASKDUR() ; -- Returns 1 or 0, if Duration prompt should be asked
  1. K ^TMP($J,"ORCDPS3 ASKDUR")
  1. N X,Y I '$G(ORCOMPLX) K ORDIALOG(PROMPT,INST) Q 0
  1. S Y=1 G:'$L($G(ORSCH)) ADQ ;no schedule
  1. D AP^PSS51P1("PSJ",,,,"ORCDPS3 ASKDUR")
  1. S X=+$O(^TMP($J,"ORCDPS3 ASKDUR","APPSJ",ORSCH,"")) G:X'>0 ADQ
  1. ;S X=+$O(^PS(51.1,"APPSJ",ORSCH,0)) G:X'>0 ADQ
  1. S:^TMP($J,"ORCDPS3 ASKDUR",X,5)="O" Y=0
  1. ;S:$P($G(^PS(51.1,X,0)),U,5)="O" Y=0
  1. ADQ ;
  1. K ^TMP($J,"ORCDPS3 ASKDUR")
  1. Q Y
  1. ;
  1. CKDUR(X) ; -- Returns validated form of duration X, or null if invalid
  1. N X1,X2,Y,Z S Y=""
  1. S X1=+$G(X),X2=$P($G(X),X1,2) I X1'>0 Q ""
  1. S X2=$$UP^XLFSTR(X2),X2=$$STRIP^XLFSTR(X2," ") S:'$L(X2) X2="DAYS"
  1. 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
  1. S:$L(Y) Y=X1_" "_$S(X1=1:$E(Y,1,$L(Y)-1),1:Y) ;strip trailing 's'
  1. Q Y
  1. ;
  1. DUR ; -- Process duration [from P-S Action]
  1. N X S X=$G(ORDIALOG(PROMPT,ORI)),X=$$CKDUR(X)
  1. I '$L(X) K DONE W $C(7),!,ORDIALOG(PROMPT,"?"),! Q
  1. S ORDIALOG(PROMPT,ORI)=X D:$G(ORESET)'=X CHANGED^ORCDPS1("QUANTITY")
  1. Q
  1. ;
  1. TEST(START,DURTN) ; -- test DEFSTRT
  1. N INST,ORSD,ORDIALOG,PROMPT
  1. S ORDIALOG(136,1)="",INST=2,ORSD="NOW",PROMPT=6
  1. S:$L($G(START)) ORDIALOG(6,1)=START S:$G(DURTN) ORDIALOG(153,1)=DURTN
  1. D DEFSTRT W !,Y
  1. Q
  1. ;
  1. SC ; -- Dialog validation, to ask SC questions
  1. ; Expects ORIFN, ORDA, and ORDER
  1. ;
  1. Q:'$L($T(SCNEW^PSOCP)) Q:'$G(ORIFN) Q:'$G(ORDA)
  1. 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)=""
  1. ;
  1. N OR3,ORDRUG,PSIFN,ORX,I,J,DIE,DR,DA,X,Y,DTOUT,ORIGVIEW,DFN
  1. S OR3=$G(^OR(100,ORIFN,3)),X=$P(OR3,U,11) I X>2 Q ;new, edit, or renew
  1. I X S Y=$P(OR3,U,5),PSIFN=$G(^OR(100,Y,4)) ;get PS# if edit/renewal
  1. S ORDRUG=$$VALUE^ORCSAVE2(ORIFN,"DRUG")
  1. D SCNEW^PSOCP(.ORX,+ORVP,ORDRUG,$G(PSIFN)) Q:'$D(ORX)
  1. S DIE="^OR(100,",DA=ORIFN,DR="",J=0
  1. 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:"")
  1. S:$E(DR)=";" DR=$E(DR,2,999) Q:'$L(DR) S ORIGVIEW=1
  1. I $D(ORX("SC")) S DFN=+ORVP D DIS^DGRPDB ;show current SC data
  1. W !!,"Is "_$$ORDITEM^ORCACT(ORDER)_" for treatment related to:"
  1. D ^DIE S:$D(DTOUT)!$D(Y) ORQUIT=1
  1. Q
  1. PRI ; Validate Priority for Outpatient orders
  1. I X?1"D".E!(X?1"d".E) K X
  1. Q
  1. ;
  1. IND ;returns indications for use
  1. Q:'$D(^TMP("PSJIND",$J))
  1. N CNT,I,TXT S (CNT,I)=0
  1. F S I=$O(^TMP("PSJIND",$J,I)) Q:'I D
  1. .S TXT=$P(^(I),"^"),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=TXT
  1. S:CNT ORDIALOG(PROMPT,"LIST")=CNT
  1. Q
  1. ;
  1. XHELP ; -- list indications for use if defined
  1. N NUM,I,CNT S (I,CNT)=0
  1. S NUM=$G(ORDIALOG(PROMPT,"LIST")) Q:'NUM
  1. W !,"Choose from:"
  1. F S I=$O(ORDIALOG(PROMPT,"LIST",I)) Q:'I D
  1. . W !,?5,I_" "_$P(ORDIALOG(PROMPT,"LIST",I),U)
  1. Q
  1. ;
  1. DFIND ; -- Get default indication for use
  1. Q
  1. ;
  1. INDIT ;
  1. I X,$D(ORDIALOG(PROMPT,"LIST",X)) Q
  1. I $E(X)=0!(X?1P.E)!(X>$G(ORDIALOG(PROMPT,"LIST"))) K X Q
  1. K:$L(X)>40!($L(X)<3) X
  1. Q
  1. ;
  1. PARKCK ;
  1. S X=$$UPPER^ORWDPS32(X)
  1. I X="M"!(X="W") Q
  1. N BX,PK S BX=X
  1. S PK=$$GET^XPAR("DIV^SYS^PKG","PSO PARK ON"),X=BX
  1. I 'PK,X="P" K X W !,"PARK is disabled at the site, PARK is not a choice."
  1. Q
  1. ;