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

ORWDPS.m

Go to the documentation of this file.
  1. ORWDPS ; SLC/KCM - Pharmacy Calls for Windows Dialog [ 08/04/96 6:57 PM ]
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
  1. ;
  1. LOAD(LST,OI,PTYP) ;
  1. ; -- For a given orderable item, load appropriate lists & defaults
  1. N I,X,CNT,ORTMP,ILST S ILST=0
  1. S LST($$NXT)="~FORMULTN" D FRMLTN
  1. S LST($$NXT)="~INSTRUCT" D INSTRCT
  1. S LST($$NXT)="~ROUTE" D ROUTE
  1. S LST($$NXT)="~SCHEDULE" D SCHED
  1. S LST($$NXT)="~PRIORITY" D PRIOR
  1. S LST($$NXT)="~MESSAGE" D MESSAGE
  1. I PTYP="O" D
  1. . S LST($$NXT)="~PICKUP" D PICKUP
  1. . S LST($$NXT)="~SCSTATUS" D SCSTS
  1. . S LST($$NXT)="~REFILLS" D REFILLS
  1. Q
  1. DISPDRUG(LST,OI) ; list dispense drugs for an orderable item
  1. N ILST,PTYP S ILST=0,PTYP="U" D FRMLTN
  1. Q
  1. FRMLTN ; formulations
  1. D ENDD^PSJORUTL("^^^"_+$P($G(^ORD(101.43,OI,0)),"^",2),PTYP,.ORTMP)
  1. S I="" F S I=$O(ORTMP(I)) Q:I="" S LST($$NXT)="i"_ORTMP(I)
  1. Q
  1. INSTRCT ; instructions
  1. D ^PSSJORDF(+$P(^ORD(101.43,OI,0),U,2))
  1. S I="" F S I=$O(^TMP("PSJINS",$J,I)) Q:I="" S X=^(I) D
  1. . I PTYP="U",$P(X,U,1)="TAKE" S $P(X,U,1)="GIVE"
  1. . S LST($$NXT)="i"_$P(X,U,2)_U_$P(X,U,1)_" "_$P(X,U,2)
  1. ; S I=$O(^TMP("PSJINS",$J,0)) (default instruction text)
  1. ; I I S X=$P($G(^TMP("PSJINS",$J,I)),U) S:$L(X) LST($$NXT)="d"_X_" "
  1. Q
  1. ROUTE ; routes
  1. S I="",CNT=0
  1. F S I=$O(^TMP("PSJMR",$J,I)) Q:I="" D
  1. . S LST($$NXT)="i"_I_U_^(I),CNT=CNT+1
  1. I CNT=1 S X=LST(ILST),LST($$NXT)="d"_$P(X,"^",3)
  1. K ^TMP("PSJINS",$J),^TMP("PSJMR",$J)
  1. Q
  1. SCHED ; schedules
  1. S I="" F S I=$O(^PS(51.1,"APPSJ",I)) Q:I="" D
  1. . S LST($$NXT)="i"_$O(^(I,0))_U_I
  1. Q
  1. PRIOR ; priorities
  1. F X="ROUTINE","ASAP","STAT","DONE" D
  1. . S LST($$NXT)="i"_$O(^ORD(101.42,"B",X,0))_U_X
  1. S LST($$NXT)="dROUTINE"
  1. Q
  1. PICKUP ; routing
  1. F X="W^at Window","M^by Mail","C^in Clinic" S LST($$NXT)="i"_X
  1. S LST($$NXT)="dat Window"
  1. Q
  1. SCSTS ; SC for drug
  1. F X="0^No","1^Yes" S LST($$NXT)="i"_X
  1. ; later: see if last order for this OI was SC and set default
  1. Q
  1. REFILLS ; refills
  1. F X=0:1:11 S LST($$NXT)="i"_X_U_X
  1. S LST($$NXT)="d0"
  1. Q
  1. MESSAGE ; message
  1. S I=0 F S I=$O(^ORD(101.43,OI,8,I)) Q:I'>0 S LST($$NXT)="i"_^(I,0)
  1. Q
  1. NXT() ; -- Function returns next available index in return data array
  1. S ILST=ILST+1
  1. Q ILST
  1. DEF(LST,INOUT) ; Load defaults for pharmacy dialogs (common lists)
  1. N TMPLST,IEN,I,X,ILST S ILST=0
  1. S LST($$NXT)="~Common" D COMMON
  1. Q
  1. COMMON ; get list of common meds
  1. S X="ORWD COMMON MED "_$S($G(INOUT)="O":"OUTPT",1:"INPT")
  1. D GETLST^XPAR(.TMPLST,"ALL",X)
  1. S I=0 F S I=$O(TMPLST(I)) Q:'I D
  1. . S IEN=$P(TMPLST(I),U,2)
  1. . S LST($$NXT)="i"_IEN_U_$P(^ORD(101.43,IEN,0),U,1)
  1. Q
  1. INPT(OK,DFN,PRV) ; For inpatient meds, check restrictions
  1. N NAME,AUTH,INACT,X S OK=0
  1. I '$D(^DPT(DFN,.1)) S OK="1^Patient is not an inpatient." Q
  1. S NAME=$P($G(^VA(200,PRV,20)),U,2) S:'$L(NAME) NAME=$P(^(0),U)
  1. S X=$G(^VA(200,PRV,"PS")),AUTH=$P(X,U),INACT=$P(X,U,4)
  1. I 'AUTH!(INACT&(DT>INACT)) D
  1. . S OK="1^"_NAME_" is not authorized to write medication orders."
  1. Q
  1. OUTPT(OK,PRV) ; For outpatient meds, check restrictions
  1. N NAME,AUTH,INACT,X S OK=0
  1. S NAME=$P($G(^VA(200,PRV,20)),U,2) S:'$L(NAME) NAME=$P(^(0),U)
  1. S X=$G(^VA(200,PRV,"PS")),AUTH=$P(X,U),INACT=$P(X,U,4)
  1. I 'AUTH!(INACT&(DT>INACT)) D
  1. . S OK="1^"_NAME_" is not authorized to write medication orders."
  1. Q