- 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
