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