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