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

ORWDPS1.m

Go to the documentation of this file.
  1. ORWDPS1 ;SLC/KCM,JLI,TC - Pharmacy Calls for Windows Dialog ;Apr 05, 2018@07:01
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,132,141,163,215,255,243,306,350,435,377,405,499**;Dec 17, 1997;Build 165
  1. ;
  1. ODSLCT(LST,PSTYPE,DFN,LOC) ; return default lists for dialog
  1. ; PSTYPE: pharmacy type (U=unit dose, F=IV fluids, O=outpatient)
  1. N ILST S ILST=0
  1. S ILST=ILST+1,LST(ILST)="~Priority" D PRIOR
  1. S ILST=ILST+1,LST(ILST)="~DispMsg"
  1. S ILST=ILST+1,LST(ILST)="d"_$$DISPMSG
  1. ;
  1. ; I PSTYPE="F" D Q ; IV Fluids
  1. ; . S ILST=ILST+1,LST(ILST)="~ShortList" D SHORT
  1. ;
  1. I PSTYPE="O" D ; Outpatient
  1. . S ILST=ILST+1,LST(ILST)="~Refills"
  1. . S ILST=ILST+1,LST(ILST)="d0^0"
  1. . S ILST=ILST+1,LST(ILST)="~Pickup"
  1. . S ILST=ILST+1,LST(ILST)="d"_$$DEFPICK($G(LOC))
  1. . ; S ILST=ILST+1,LST(ILST)="~Supply"
  1. . ; S ILST=ILST+1,LST(ILST)="d^"_$$DEFSPLY(DFN)
  1. Q
  1. PKI(ORY,OI,PSTYPE,ORVP,PKIACTIV) ; return DEA Schedule for drug
  1. N ILST,ORDOSE,ORWPSOI,ORWDOSES,X1,X2,X
  1. K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
  1. S ILST=0
  1. S ORWPSOI=0
  1. S:+OI ORWPSOI=+$P($G(^ORD(101.43,+OI,0)),U,2)
  1. D START^PSSJORDF(ORWPSOI,$S(PSTYPE="U":"I",1:"O")) ; dflt route, schedule, etc.
  1. I '$L($T(DOSE^PSSOPKI1)) D DOSE^PSSORUTL(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses
  1. I $L($T(DOSE^PSSOPKI1)) D DOSE^PSSOPKI1(.ORDOSE,ORWPSOI,PSTYPE,ORVP) ; dflt doses NEW PKI CODE from pharmacy
  1. D EN^PSSDIN(ORWPSOI) ; nfi text
  1. S ORY="" ;PKI
  1. I $D(ORDOSE("DEA")) S X="",X1=$P(ORDOSE("DEA"),";"),X2=$P(ORDOSE("DEA"),";",2) D
  1. . I '$L(X2) Q
  1. . I $G(PKIACTIV) S X=X2
  1. S ORY=X
  1. K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J),^TMP("PSSDIN",$J)
  1. Q
  1. PRIOR ; from DLGSLCT, get list of allowed priorities
  1. N X,XREF,ORX
  1. S XREF=$S(PSTYPE="O":"S.PSO",1:"S.PSJ")
  1. S X="" F S X=$O(^ORD(101.42,XREF,X)) Q:'$L(X) D
  1. . I XREF["PSO",X="DONE" Q
  1. . I $D(^ORD(101.42,"B","ASAP")) S ORPRA=$O(^ORD(101.42,"B","ASAP",0))
  1. . I '$D(^ORD(101.42,"B","ASAP")) S ORPRA=$$GET^XPAR("ALL","ORDER URGENCY ASAP ALTERNATIVE")
  1. . S ORX=$P($G(^ORD(101.42,ORPRA,0)),U,1)
  1. . I XREF["PSJ",X'=ORX,X'="ROUTINE",X'="STAT" Q
  1. . S ILST=ILST+1,LST(ILST)="i"_$O(^ORD(101.42,XREF,X,0))_U_X
  1. S ILST=ILST+1,LST(ILST)="d"_$O(^ORD(101.42,"B","ROUTINE",0))_U_"ROUTINE"
  1. Q
  1. GETPRIOR(ORX) ; from RPC ORWDPS1 GETPRIOR gets sites alterative to "ASAP" if present
  1. N ORPRA
  1. I $D(^ORD(101.42,"B","ASAP")) S ORPRA=$O(^ORD(101.42,"B","ASAP",0))
  1. I '$D(^ORD(101.42,"B","ASAP")) S ORPRA=$$GET^XPAR("ALL","ORDER URGENCY ASAP ALTERNATIVE")
  1. S ORX=$P($G(^ORD(101.42,ORPRA,0)),U,1)
  1. Q ORX
  1. ;
  1. GETPRIEN(ORPRA) ; from RPC ORWDPS1 GETPRIEN gets sites alterative to "ASAP" IEN if present
  1. I $D(^ORD(101.42,"B","ASAP")) S ORPRA=$O(^ORD(101.42,"B","ASAP",0))
  1. I '$D(^ORD(101.42,"B","ASAP")) S ORPRA=$$GET^XPAR("ALL","ORDER URGENCY ASAP ALTERNATIVE")
  1. Q ORPRA
  1. DEFPICK(LOC) ; return default routing
  1. N X,DLG,PRMT
  1. S DLG=$O(^ORD(101.41,"AB","PSO OERR",0)),X=""
  1. S PRMT=$O(^ORD(101.41,"AB","OR GTX ROUTING",0))
  1. I $D(^TMP("ORECALL",$J,+DLG,+PRMT,1)) S X=^(1)
  1. I X'="" S EDITONLY=1 Q X ; EDITONLY used by default action
  1. ;
  1. ;S X=$$GET^XPAR("ALL^"_"LOC.`"_LOC,"ORWDPS ROUTING DEFAULT",1,"I")
  1. S X=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
  1. I X="C" S X="C^in Clinic" G XPICK
  1. I X="M" S X="M^by Mail" G XPICK
  1. I X="W" S X="W^at Window" G XPICK
  1. I X="P" S X="P^Park" G XPICK ;ADDED PAPI CODE
  1. I X="N" S X="" G XPICK
  1. I X="" S X=$S($D(^PSX(550,"C")):"M^by Mail",1:"W^at Window")
  1. XPICK Q X
  1. ;
  1. DEFSPLY(DFN) ; return default days supply for this patient
  1. N ORWX
  1. S ORWX("PATIENT")=DFN
  1. D DSUP^PSOSIGDS(.ORWX)
  1. Q $G(ORWX("DAYS SUPPLY"))
  1. ;
  1. DFLTSPLY(VAL,UPD,SCH,PAT,DRG,OI) ; return days supply given quantity
  1. ; VAL: default days supply
  1. N ORWX,I,PSOI,TPKG
  1. S ORWX("PATIENT")=PAT
  1. I DRG S ORWX("DRUG")=DRG
  1. I $D(OI) D
  1. . S TPKG=$P($G(^ORD(101.43,+$G(OI),0)),U,2) Q:TPKG'["PS"
  1. . S PSOI=+TPKG Q:PSOI'>0
  1. . S ORWX("OI")=PSOI
  1. F I=1:1:$L(UPD,U)-1 D
  1. . S ORWX("DOSE ORDERED",I)=$P(UPD,U,I)
  1. . S ORWX("SCHEDULE",I)=$P(SCH,U,I)
  1. D DSUP^PSOSIGDS(.ORWX)
  1. S VAL=$G(ORWX("DAYS SUPPLY"))
  1. Q
  1. DISPMSG() ; return 1 to suppress dispense message
  1. Q +$$GET^XPAR("ALL","ORWDPS SUPPRESS DISPENSE MSG",1,"I")
  1. ;
  1. DOWSCH(LST,DFN,LOCIEN) ; return all schedules
  1. N CNT,FREQ,ILST,ORARRAY,WIEN
  1. S WIEN=$$WARDIEN^ORWDPS32(+$G(LOCIEN))
  1. D SCHED^PSS51P1(WIEN,.ORARRAY)
  1. S ILST=0
  1. S CNT=0 F S CNT=$O(ORARRAY(CNT)) Q:CNT'>0 D
  1. .S NODE=$G(ORARRAY(CNT))
  1. .I $P(NODE,U,4)="C" D
  1. ..K ^TMP($J,"ORWDPS1 DOWSCH")
  1. ..D ZERO^PSS51P1($P(NODE,U),,,,"ORWDPS1 DOWSCH")
  1. ..S FREQ=$G(^TMP($J,"ORWDPS1 DOWSCH",$P(NODE,U),2))
  1. ..K ^TMP($J,"ORWDPS1 DOWSCH")
  1. ..I +FREQ=0 Q
  1. ..I +FREQ>1440 Q
  1. ..S ILST=ILST+1,LST(ILST)=$P(ORARRAY(CNT),U,2,5)
  1. Q
  1. ;
  1. SCHALL(LST,DFN,LOCIEN) ; return all schedules
  1. N CNT,ILST,ORARRAY,WIEN
  1. S WIEN=$$WARDIEN^ORWDPS32(+$G(LOCIEN))
  1. D SCHED^PSS51P1(WIEN,.ORARRAY)
  1. S ILST=0
  1. S CNT=0 F S CNT=$O(ORARRAY(CNT)) Q:CNT'>0 D
  1. .S ILST=ILST+1,LST(ILST)=$P(ORARRAY(CNT),U,2,5)
  1. Q
  1. ;
  1. FORMALT(ORLST,ORIEN,PSTYPE) ; return a list of formulary alternatives
  1. N PSID,I
  1. S ORIEN=+$P(^ORD(101.43,ORIEN,0),U,2)
  1. D EN1^PSSUTIL1(.ORIEN,PSTYPE)
  1. S PSID=0,I=0
  1. F S PSID=$O(ORIEN(PSID)) Q:'PSID D
  1. . S OI=+$O(^ORD(101.43,"ID",PSID_";99PSP",0))
  1. . I OI S I=I+1,ORLST(I)=OI,$P(ORLST(I),U,2)=$P(^ORD(101.43,OI,0),U)
  1. Q
  1. DOSEALT(LST,DDRUG,CUROI,PSTYPE) ; return a list of formulary alternatives for dose
  1. N I,OI,ORWLST,ILST S ILST=0
  1. D ENRFA^PSJORUTL(DDRUG,PSTYPE,.ORWLST)
  1. S I=0 F S I=$O(ORWLST(I)) Q:'I D
  1. . S OI=+$O(^ORD(101.43,"ID",+$P(ORWLST(I),U,4)_";99PSP",0))
  1. . I OI,OI'=CUROI S ILST=ILST+1,LST(ILST)=OI_U_$P(^ORD(101.43,OI,0),U)
  1. Q
  1. QOMEDALT(ORY,ODIEN) ;
  1. N ARRAY,IDIEN,ORDERID,PKG,PSTYPE,VALUE
  1. S ORY=0,PKG=+$P(^ORD(101.41,ODIEN,0),U,7)
  1. S PSTYPE=$S($$GET1^DIQ(9.4,PKG_",",1)="PSO":"O",1:"I")
  1. S ORDERID=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM","")) Q:ORDERID'>0
  1. S IDIEN=$O(^ORD(101.41,ODIEN,6,"D",ORDERID,"")) Q:IDIEN'>0
  1. S VALUE=$G(^ORD(101.41,ODIEN,6,IDIEN,1)) Q:VALUE'>0
  1. I $P($G(^ORD(101.43,VALUE,"PS")),U,6)=1 S ORY=VALUE
  1. ;D FORMALT(.ARRAY,VALUE,PSTYPE) I $D(ARRAY)>0 S ORY=VALUE
  1. ;I ORY=0,$P($G(^ORD(101.43,VALUE,"PS")),U,6)=1 S ORY=VALUE
  1. Q
  1. FAILDEA(FAIL,OI,ORNP,PSTYPE) ; return 1 if DEA check fails for this provider
  1. N DEAFLG,PSOI,TPKG,RT,DETFLG,DETPRO
  1. S FAIL=0,TPKG=$P($G(^ORD(101.43,+$G(OI),0)),U,2)
  1. Q:TPKG'["PS"
  1. S PSOI=+TPKG Q:PSOI'>0
  1. S DETFLAG=$$OIDETOX^PSSOPKI(PSOI,PSTYPE)
  1. S DETPRO=$$DETOX^XUSER(+$G(ORNP))
  1. I DETFLAG,DETPRO="" S FAIL=3 Q
  1. I DETFLAG,DETPRO>0 S Y=DETPRO X ^DD("DD") S FAIL="5^"_Y Q
  1. S DEAFLG=$P($$OIDEA^PSSOPKI(PSOI,PSTYPE),";",2) Q:DEAFLG'>0
  1. I DEAFLG=1 S FAIL=6 Q
  1. S RT=$$SDEA^XUSER(1,+$G(ORNP),DEAFLG,,"I") I RT=1 S FAIL=1 ; OR*3*499-Default to the required "Use For Inpatient" DEA# until selection from list is enabled
  1. I RT=2 S FAIL="2^"_$$UP^XLFSTR(DEAFLG)
  1. I RT?1"4".E S FAIL=RT
  1. Q
  1. FDEA1(FAIL,OI,OITYPE,ORNP) ; only be called for an outpaitent and IV dialog
  1. ;OI: IV Orderable Item
  1. ;OITYPE: A:ADDITIVE S:SOLUTION
  1. N DEAFLG,PSOI,TKPG,RT,DETFLG,DETPRO
  1. S FAIL=0,TPKG=$P($G(^ORD(101.43,+$G(OI),0)),U,2)
  1. Q:TPKG'["PS"
  1. S PSOI=+TPKG Q:PSOI'>0
  1. S DETFLAG=$$OIDETOX^PSSOPKI(PSOI,"I")
  1. S DETPRO=$$DETOX^XUSER(+$G(ORNP))
  1. I DETFLAG,DETPRO="" S FAIL=3 Q
  1. I DETFLAG,DETPRO>0 S Y=DETPRO X ^DD("DD") S FAIL="5^"_Y Q
  1. S DEAFLG=$P($$IVDEA^PSSUTIL1(PSOI,OITYPE),";",2) Q:DEAFLG'>0
  1. I DEAFLG=1 S FAIL=6 Q
  1. S RT=$$SDEA^XUSER(,+$G(ORNP),DEAFLG) I RT=1 S FAIL=1
  1. I RT=2 S FAIL="2^"_$$UP^XLFSTR(DEAFLG)
  1. I RT?1"4".E S FAIL=RT
  1. Q
  1. ;
  1. CHK94(VAL) ; return 1 if patch 94 has been installed
  1. S VAL=0
  1. I $O(^ORD(101.41,"B","PS MEDS",0)) S VAL=1
  1. Q
  1. LOCPICK(Y,LOC) ; return default Location level routing
  1. S Y=""
  1. S Y=$$GET^XPAR("LOC.`"_LOC_"^SYS","ORWDPS ROUTING DEFAULT",1,"I")
  1. I Y="C" S Y="C^in Clinic"
  1. I Y="M" S Y="M^by Mail"
  1. I Y="W" S Y="W^at Window"
  1. I Y="P" S Y="P^Park" ;ADDED PAPI CODE
  1. I Y="N" S Y=""
  1. Q
  1. HASOIPI(Y,QOID) ; Check if QO put orderable item's PI into Sig
  1. N PIIEN,OIX
  1. S Y=0
  1. Q:'$D(^ORD(101.41,QOID,0))
  1. S PIIEN=$O(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",0))
  1. Q:'PIIEN
  1. S OIX=0
  1. Q:'$D(^ORD(101.41,QOID,6,"D"))
  1. F S OIX=$O(^ORD(101.41,+QOID,6,"D",OIX)) Q:'OIX D
  1. . I OIX=PIIEN S Y=1 Q
  1. Q
  1. HASROUTE(Y,QOID) ;Check if QO has a ROUTE defined
  1. N ROUTID
  1. S Y=0,ROUTID=0
  1. S ROUTID=$O(^ORD(101.41,"B","OR GTX ROUTING",0))
  1. Q:'ROUTID
  1. Q:'$D(^ORD(101.41,+QOID))
  1. I $D(^ORD(101.41,+QOID,6,"D",ROUTID)) S Y=1
  1. Q
  1. QOCHECK(ORY,DIEN) ;
  1. N ARY,DG,FORMIEN,NAME,OI,OIIEN,ORDIALOG,ORPKG,TYPE
  1. S ORPKG=$$NMSP^ORCD($P($G(^ORD(101.41,DIEN,0)),U,7)) Q:ORPKG'["PS"
  1. S DG=$P(^ORD(101.41,DIEN,0),U,5)
  1. S NAME=$P(^ORD(100.98,DIEN,0),U)
  1. S TYPE=$S(NAME="INPATIENT MEDICATIONS":"I",NAME="OUTPATIENT MEDICATIONS":"O",1:"")
  1. I TYPE="" Q
  1. S ORDIALOG=$$DEFDLG^ORCD(DIEN) Q:ORDIALOG
  1. D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD("^ORD(101.41,"_DIEN_",6)")
  1. I $D(ORDIALOG)'>0 Q
  1. S OI=$P($G(ORDIALOG("B","ORDERABLE")),U,2) Q:OI'>0
  1. S OIIEN=$G(ORDIALOG(OI,1)) Q:OIIEN'>0
  1. D FORMALT(.ARY,OIIEN,TYPE) I $D(ARY)'>0 Q
  1. S ORY=OIIEN
  1. Q
  1. MAXDS(ORY,ORDIEN,ORDRIEN) ;
  1. ; ORDIEN IS orderable item ien 101.43
  1. ; ORDRIEN IS the drug ien
  1. ; RETURN IS THE MAX DAYS SUPPLY FOR THE ORDERABLE ITEM
  1. S ORY=90
  1. I $L($T(MAXDS^PSSUTIL1))>0 D
  1. .N ORARRAY
  1. .I $G(ORDRIEN) D
  1. ..S ORARRAY("DRUG")=ORDRIEN
  1. .S ORARRAY("OI")=ORDIEN
  1. .I $G(ORDIEN) D
  1. ..N ORPSOI S ORPSOI=$P($G(^ORD(101.43,+ORDIEN,0)),U,2)
  1. ..S ORARRAY("PSOI")=+ORPSOI
  1. .S ORY=$$MAXDS^PSSUTIL1(.ORARRAY)
  1. Q