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

ORBCMA1.m

Go to the documentation of this file. 
  1. ORBCMA1 ; SLC/JLI - Pharmacy Calls for Windows Dialog [ 3/7/2006 ]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**133,243,499**;Dec 17, 1997;Build 165
  1.  ;;OR BCMA ORDER COM V1.0 ;**133**; Jan 19, 2002
  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. PRIOR ; from DLGSLCT, get list of allowed priorities
  1.  N X,XREF
  1.  S X=0
  1.  S X=$O(^ORD(101.42,"B","DONE",X))
  1.  S ILST=ILST+1,LST(ILST)="d"_X_U_$P(^ORD(101.42,X,0),U,2)
  1.  Q
  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.  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="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)        ; return days supply given quantity
  1.  ; VAL: default days supply
  1.  N ORWX,I
  1.  S ORWX("PATIENT")=PAT
  1.  I DRG S ORWX("DRUG")=DRG
  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. SCHALL(LST) ; return all schedules
  1.  N ILST,SCH,IEN,EXP,TYP,X0
  1.  K ^TMP($J,"ORBCMA1 SCHALL")
  1.  D AP^PSS51P1("PSJ",,,,"ORBCMA1 SCHALL")
  1.  S ILST=0,SCH=""
  1.  F  S SCH=$O(^TMP($J,"ORBCMA1 SCHALL","APPSJ",SCH)) Q:SCH=""  D
  1.  . I (SCH="STAT")!(SCH="NOW") D
  1.  .. S IEN=$O(^TMP($J,"ORBCMA1 SCHALL","APPSJ",SCH,""))
  1.  .. S EXP=$G(^TMP($J,"ORBCMA1 SCHALL",SCH,8))
  1.  .. S TYP=$P($G(^TMP($J,"ORBCMA1 SCHALL",SCH,5)),U)
  1.  .. S ILST=ILST+1,LST(ILST)=SCH_U_EXP_U_TYP
  1.  K ^TMP($J,"ORBCMA1 SCHALL")
  1.  Q
  1. FORMALT(ORLST,IEN,PSTYPE) ; return a list of formulary alternatives
  1.  N PSID,I
  1.  S IEN=+$P(^ORD(101.43,IEN,0),U,2)
  1.  D EN1^PSSUTIL1(.IEN,PSTYPE)
  1.  S PSID=0,I=0
  1.  F  S PSID=$O(IEN(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. FAILDEA(FAIL,OI,ORNP,PSTYPE)    ; return 1 if DEA check fails for this provider
  1.  N DEAFLG,PSOI,ORDEA
  1.  S FAIL=0,PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2) Q:PSOI'>0
  1.  I '$L($T(OIDEA^PSSUTLA1)) Q
  1.  S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,PSTYPE) Q:DEAFLG'>0
  1.  ;*499 introduces multiple dea's for provider
  1.  S ORDEA=$$PRDEA^XUSER(ORNP) I '$L(ORDEA),'$L($P($G(^VA(200,+ORNP,"PS")),U,3)) S FAIL=1
  1.  ;I '$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) S FAIL=1
  1.  Q
  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