Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDPSH.m

    r613 r623  
    1 ORCDPSH ;SLC/CLA-Pharmacy dialog utilities-Non-VA Meds ; 09 April 2003 11:00 AM
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,215,243**;Dec 17, 1997;Build 242
    3         ;
    4         ; DBIA 2418   START^PSSJORDF   ^TMP("PSJMR",$J)
    5         ; DBIA 3166   EN^PSSDIN        ^TMP("PSSDIN",$J)
    6         ;
    7 EN(TYPE)        ; -- entry action for Meds dialogs
    8         S ORDG=+$O(^ORD(100.98,"B","NV RX",0)),ORCAT="O"
    9         K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
    10         I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT)!$G(ORXFER) D
    11         . K ORDIALOG($$PTR("START DATE/TIME"),1)
    12         . K ORDIALOG($$PTR("NOW"),1)
    13         . I $D(OREDIT),'$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) K ^TMP("ORWORD",$J)
    14         Q
    15         ;
    16 EN1     ; -- setup Non-VA Meds dialog for quick order editor using ORDG
    17         N DG S DG=$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)
    18         S ORINPT=0,ORCAT="O"
    19         K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
    20         Q
    21         ;
    22 ENOI    ; -- setup OI prompt
    23         S ORDIALOG(PROMPT,"D")="S.NV RX"
    24         Q
    25         ;
    26 CHANGED(X)      ; -- Kill dependent values when prompt X changes
    27         N PROMPTS,NAME,PTR,P,I
    28         S PROMPTS=X I X="OI" D
    29         . S PROMPTS="INSTRUCTIONS^ROUTE^SCHEDULE^START DATE/TIME^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS"
    30         . K ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY
    31         . K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
    32         F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
    33         . S PTR=$$PTR(NAME) Q:'PTR
    34         . S I=0 F  S I=$O(ORDIALOG(PTR,I)) Q:I'>0  K ORDIALOG(PTR,I)
    35         . K ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$J,PTR)
    36         Q
    37         ;
    38 ORDITM(OI)      ; -- Check OI inactive date & type, get dependent info
    39         Q:OI'>0  ;quit - no value
    40         N ORPS,PSOI S ORPS=$G(^ORD(101.43,+OI,"PS")),PSOI=+$P($G(^(0)),U,2)
    41         S ORIV=$S($P(ORPS,U)=2:1,1:0)
    42         I '$P(ORPS,U,7) W $C(7),!,"This drug may not be used in a non-VA med order." S ORQUIT=1 D WAIT Q
    43 OI1     ; ck NF status (don't care if Non-VA Meds are formulary or not)
    44 OI2     ; -get selectable routes, doses [also called from NF^ORCDPS]
    45         D:'$D(^TMP("PSJMR",$J)) START^PSSJORDF(PSOI,$G(ORCAT))  ;DBIA 2418
    46         I '$D(ORDOSE) D
    47         . D DOSE^PSSORUTL(.ORDOSE,PSOI,"X",+ORVP)
    48         . K:$G(ORDOSE(1))=-1 ORDOSE
    49         Q
    50         ;
    51 NFI(OI) ; -- Show NFI restrictions, if exist
    52         N PSOI,I,J,LCNT,MAX,X,STOP
    53         S PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2)
    54         D EN^PSSDIN(PSOI,"") Q:'$D(^TMP("PSSDIN",$J,"OI",PSOI))  ;DBIA 3166
    55         S I=0,LCNT=0,MAX=$S($G(IOBM)&$G(IOTM):IOBM-IOTM+1,1:24) W !
    56         F  S I=$O(^TMP("PSSDIN",$J,"OI",PSOI,I)) Q:I'>0  D
    57         . S J=0 F  S J=$O(^TMP("PSSDIN",$J,"OI",PSOI,I,J)) Q:J'>0  S X=$G(^(J)) D  Q:$G(STOP)
    58         .. S LCNT=LCNT+1 I LCNT'<MAX S:'$$CONT STOP=1 Q:$G(STOP)  S LCNT=1
    59         .. W !,X
    60         W ! K ^TMP("PSSDIN",$J,"OI",PSOI)
    61         Q
    62         ;
    63 CONT()  ; -- Press return to cont or ^ to stop
    64         N X,Y,DIR,DUOUT,DTOUT,DIRUT,DIROUT S DIR(0)="EA"
    65         S DIR("A")="Press <return> to continue or ^ to stop ..."
    66         D ^DIR S:$D(DUOUT)!$D(DTOUT) Y=""
    67         Q +Y
    68         ;
    69 WAIT    ; -- Wait for user
    70         N X W !,"Press <return> to continue ..." R X:DTIME
    71         Q
    72         ;
    73 ROUTES  ; -- Get allowable med routes
    74         Q:$G(ORDIALOG(PROMPT,"LIST"))  N I,X,CNT S (I,CNT)=0
    75         F  S I=$O(^TMP("PSJMR",$J,I)) Q:I'>0  S X=^(I),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=$P(X,U,3)_U_$P(X,U,1,2),ORDIALOG(PROMPT,"LIST","B",$P(X,U))=$P(X,U,3)
    76         S:$G(CNT) ORDIALOG(PROMPT,"LIST")=CNT
    77         S REQD=0
    78         Q
    79         ;
    80 DEFRTE  ; -- Get default route
    81         N INST1 S INST1=$O(ORDIALOG(PROMPT,0)) S:INST1'>0 INST1=INST ;1st inst
    82         I INST1=INST S Y=+$P($G(^TMP("PSJMR",$J,1)),U,3) K:Y'>0 Y Q
    83         S Y=+$G(ORDIALOG(PROMPT,INST1)) K:Y'>0 Y S:$G(Y) EDITONLY=1
    84         Q
    85         ;
    86 CKSCH   ; -- validate schedule [Called from P-S Action]
    87         N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET)  K ORSD ;reset
    88         D EN^PSSGS0(.ORX,"X")
    89         I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX D CHANGED("QUANTITY") Q  ;ok
    90         W $C(7),!,"Enter a standard schedule for administering this medication or one of your own,",!,"up to 20 characters.",!
    91         K DONE
    92         Q
    93         ;
    94 PTR(X)  ; -- Return ptr to prompt OR GTX X
    95         Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
    96         ;
    97 EXIT    ; -- exit action for Meds dialogs
    98         S:$G(ORXNP) ORNP=ORXNP
    99         K ORXNP,ORINPT,ORCAT,ORPKG,OROI,ORIV,ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,OREFILLS,ORQTY,ORQTYUNT,ORCOPAY,PSJNOPC,ORCOMPLX
    100         K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
    101         Q
     1ORCDPSH ;SLC/CLA-Pharmacy dialog utilities-Non-VA Meds ; 09 April 2003 11:00 AM
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**190,215**;Dec 17, 1997
     3 ;
     4 ; DBIA 2418   START^PSSJORDF   ^TMP("PSJMR",$J)
     5 ; DBIA 3166   EN^PSSDIN        ^TMP("PSSDIN",$J)
     6 ;
     7EN(TYPE) ; -- entry action for Meds dialogs
     8 S ORDG=+$O(^ORD(100.98,"B","NV RX",0)),ORCAT="O"
     9 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
     10 I $G(ORENEW)!$G(OREWRITE)!$D(OREDIT)!$G(ORXFER) D
     11 . K ORDIALOG($$PTR("START DATE/TIME"),1)
     12 . K ORDIALOG($$PTR("NOW"),1)
     13 . I $D(OREDIT),'$O(ORDIALOG($$PTR^ORCD("OR GTX INSTRUCTIONS"),0)) K ^TMP("ORWORD",$J)
     14 Q
     15 ;
     16EN1 ; -- setup Non-VA Meds dialog for quick order editor using ORDG
     17 N DG S DG=$P($G(^ORD(100.98,+$G(ORDG),0)),U,3)
     18 S ORINPT=0,ORCAT="O"
     19 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
     20 Q
     21 ;
     22ENOI ; -- setup OI prompt
     23 S ORDIALOG(PROMPT,"D")="S.NV RX"
     24 Q
     25 ;
     26CHANGED(X) ; -- Kill dependent values when prompt X changes
     27 N PROMPTS,NAME,PTR,P,I
     28 S PROMPTS=X I X="OI" D
     29 . S PROMPTS="INSTRUCTIONS^ROUTE^SCHEDULE^START DATE/TIME^DOSE^DISPENSE DRUG^SIG^PATIENT INSTRUCTIONS"
     30 . K ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,ORQTY,ORQTYUNT,OREFILLS,ORCOPAY
     31 . K ^TMP("PSJINS",$J),^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
     32 F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P) D
     33 . S PTR=$$PTR(NAME) Q:'PTR
     34 . S I=0 F  S I=$O(ORDIALOG(PTR,I)) Q:I'>0  K ORDIALOG(PTR,I)
     35 . K ORDIALOG(PTR,"LIST"),^TMP("ORWORD",$J,PTR)
     36 Q
     37 ;
     38ORDITM(OI) ; -- Check OI inactive date & type, get dependent info
     39 Q:OI'>0  ;quit - no value
     40 N ORPS,PSOI S ORPS=$G(^ORD(101.43,+OI,"PS")),PSOI=+$P($G(^(0)),U,2)
     41 S ORIV=$S($P(ORPS,U)=2:1,1:0)
     42 I '$P(ORPS,U,7) W $C(7),!,"This drug may not be used in a non-VA med order." S ORQUIT=1 D WAIT Q
     43OI1 ; ck NF status (don't care if Non-VA Meds are formulary or not)
     44OI2 ; -get selectable routes, doses [also called from NF^ORCDPS]
     45 D:'$D(^TMP("PSJMR",$J)) START^PSSJORDF(PSOI,$G(ORCAT))  ;DBIA 2418
     46 I '$D(ORDOSE) D
     47 . D DOSE^PSSORUTL(.ORDOSE,PSOI,"X",+ORVP)
     48 . K:$G(ORDOSE(1))=-1 ORDOSE
     49 Q
     50 ;
     51NFI(OI) ; -- Show NFI restrictions, if exist
     52 N PSOI,I,J,LCNT,MAX,X,STOP
     53 S PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2)
     54 D EN^PSSDIN(PSOI,"") Q:'$D(^TMP("PSSDIN",$J,"OI",PSOI))  ;DBIA 3166
     55 S I=0,LCNT=0,MAX=$S($G(IOBM)&$G(IOTM):IOBM-IOTM+1,1:24) W !
     56 F  S I=$O(^TMP("PSSDIN",$J,"OI",PSOI,I)) Q:I'>0  D
     57 . S J=0 F  S J=$O(^TMP("PSSDIN",$J,"OI",PSOI,I,J)) Q:J'>0  S X=$G(^(J)) D  Q:$G(STOP)
     58 .. S LCNT=LCNT+1 I LCNT'<MAX S:'$$CONT STOP=1 Q:$G(STOP)  S LCNT=1
     59 .. W !,X
     60 W ! K ^TMP("PSSDIN",$J,"OI",PSOI)
     61 Q
     62 ;
     63CONT() ; -- Press return to cont or ^ to stop
     64 N X,Y,DIR,DUOUT,DTOUT,DIRUT,DIROUT S DIR(0)="EA"
     65 S DIR("A")="Press <return> to continue or ^ to stop ..."
     66 D ^DIR S:$D(DUOUT)!$D(DTOUT) Y=""
     67 Q +Y
     68 ;
     69WAIT ; -- Wait for user
     70 N X W !,"Press <return> to continue ..." R X:DTIME
     71 Q
     72 ;
     73ROUTES ; -- Get allowable med routes
     74 Q:$G(ORDIALOG(PROMPT,"LIST"))  N I,X,CNT S (I,CNT)=0
     75 F  S I=$O(^TMP("PSJMR",$J,I)) Q:I'>0  S X=^(I),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=$P(X,U,3)_U_$P(X,U,1,2),ORDIALOG(PROMPT,"LIST","B",$P(X,U))=$P(X,U,3)
     76 S:$G(CNT) ORDIALOG(PROMPT,"LIST")=CNT
     77 S REQD=0
     78 Q
     79 ;
     80DEFRTE ; -- Get default route
     81 N INST1 S INST1=$O(ORDIALOG(PROMPT,0)) S:INST1'>0 INST1=INST ;1st inst
     82 I INST1=INST S Y=+$P($G(^TMP("PSJMR",$J,1)),U,3) K:Y'>0 Y Q
     83 S Y=+$G(ORDIALOG(PROMPT,INST1)) K:Y'>0 Y S:$G(Y) EDITONLY=1
     84 Q
     85 ;
     86CKSCH ; -- validate schedule [Called from P-S Action]
     87 N ORX S ORX=ORDIALOG(PROMPT,ORI) Q:ORX=$G(ORESET)  K ORSD ;reset
     88 D EN^PSSGS0(.ORX,"X")
     89 I $D(ORX) S ORDIALOG(PROMPT,ORI)=ORX D CHANGED("QUANTITY") Q  ;ok
     90 W $C(7),!,"Enter either a standard administration schedule or one of your own,",!,"up to 70 characters and no more than 2 spaces.",!
     91 K DONE
     92 Q
     93 ;
     94PTR(X) ; -- Return ptr to prompt OR GTX X
     95 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
     96 ;
     97EXIT ; -- exit action for Meds dialogs
     98 S:$G(ORXNP) ORNP=ORXNP
     99 K ORXNP,ORINPT,ORCAT,ORPKG,OROI,ORIV,ORDRUG,ORDOSE,OROUTE,ORSCH,ORSD,ORDSUP,OREFILLS,ORQTY,ORQTYUNT,ORCOPAY,PSJNOPC,ORCOMPLX
     100 K ^TMP("PSJMR",$J),^TMP("PSJNOUN",$J),^TMP("PSJSCH",$J)
     101 Q
Note: See TracChangeset for help on using the changeset viewer.