| 1 | ORCMED ;SLC/MKB-Medication actions ;4/2/02 16:45
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,7,38,48,94,141,178,190,195**;Dec 17, 1997
|
|---|
| 3 | XFER ; -- transfer to in/outpt meds
|
|---|
| 4 | N ORPTLK,ORTYPE,ORXFER,ORSRC,ORCAT,OREVENT,X,ORINPT,ORIDLG,ORODLG,ORIVDLG,ORNMSP,ORCNT,ORI,NMBR,ORIFN,OLDIFN,ORDIALOG,ORDG,ORCHECK,ORQUIT,ORDUZ,ORLOG,FIRST,ORDITM,ORD,ORERR
|
|---|
| 5 | S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK D G XFQ ; lock pt chart
|
|---|
| 6 | . W !!,$C(7),$P(ORPTLK,U,2) H 2
|
|---|
| 7 | . S:'$D(VALMBCK) VALMBCK=""
|
|---|
| 8 | I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("transfer") G:'ORNMBR XFQ
|
|---|
| 9 | D FULL^VALM1 S VALMBCK="R",ORTYPE="Q",ORXFER=1,ORDUZ=DUZ,ORSRC="X"
|
|---|
| 10 | S X=$P($P($G(^TMP("OR",$J,"CURRENT",0)),U,3),";",3) S:X="" X=$G(ORWARD)
|
|---|
| 11 | S ORCAT=$S(X:"O",1:"I") I ORCAT="I"!$G(ORWARD) D Q:$G(OREVENT)="^"
|
|---|
| 12 | . W !!,$$CURRENT^OREVNT
|
|---|
| 13 | . S X=$$DELAY^ORCACT I X="^" S OREVENT="^" Q
|
|---|
| 14 | . S:X OREVENT=+$$PTEVENT^OREVNT(+ORVP,1)
|
|---|
| 15 | I '$G(ORL) S ORL=$S($G(OREVENT):$$LOC^OREVNTX(OREVENT),1:$$LOCATION^ORCMENU1) G:ORL="^" XFQ
|
|---|
| 16 | S ORINPT=$$INPT^ORCD,ORNP=$$PROVIDER^ORCMENU1 G:ORNP="^" XFQ
|
|---|
| 17 | I 'ORINPT,ORCAT="I" D IMOLOC^ORIMO(.ORINPT,+ORL,+ORVP) S:ORINPT<0 ORINPT=0 ;allow inpt meds at this location?
|
|---|
| 18 | S ORIDLG=+$O(^ORD(101.41,"AB","PSJ OR PAT OE",0))
|
|---|
| 19 | S ORODLG=+$O(^ORD(101.41,"AB","PSO OERR",0))
|
|---|
| 20 | S ORIVDLG=+$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
|
|---|
| 21 | D PROVIDER^ORCDPSIV G:$G(ORQUIT) XFQ ;X:$D(^ORD(101.41,ORDIALOG,3)) ^(3)
|
|---|
| 22 | S ORNMSP="PS" D DISPLAY^ORCHECK
|
|---|
| 23 | S ORCNT=$L(ORNMBR,",") S:$P(ORNMBR,",",ORCNT)'>0 ORCNT=ORCNT-1
|
|---|
| 24 | XF1 F ORI=1:1:ORCNT S NMBR=$P(ORNMBR,",",ORI) D:NMBR I $D(ORQUIT),ORI<ORCNT Q:'$$CONT ;if not last one, ask
|
|---|
| 25 | . K ORIFN,ORDIALOG,ORDG,ORDOSE,ORCHECK,ORQUIT,ORERR
|
|---|
| 26 | . K ^TMP("PSJMR",$J),^TMP("ORWORD",$J),^TMP("ORSIG",$J)
|
|---|
| 27 | . S OLDIFN=+$P($G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),U,4)
|
|---|
| 28 | . S ORDITM=$$ORDITEM^ORCACT(OLDIFN) D SUBHDR^ORCACT(ORDITM)
|
|---|
| 29 | . I '$$VALID^ORCACT0(OLDIFN,"XFR",.ORERR) W !,ORERR H 2 Q
|
|---|
| 30 | . S ORD=$P($G(^OR(100,OLDIFN,0)),U,5) Q:ORD'["101.41" ;error msg?
|
|---|
| 31 | . S ORDIALOG=$S(+ORD=ORIVDLG:ORIVDLG,ORCAT="I":ORIDLG,1:ORODLG)
|
|---|
| 32 | . S ORDG=+$P($G(^ORD(101.41,ORDIALOG,0)),U,5)
|
|---|
| 33 | . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(OLDIFN)
|
|---|
| 34 | . I ORDIALOG'=ORIVDLG D OUT:ORCAT="I",IN:ORCAT="O" ;convert data
|
|---|
| 35 | . K ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)
|
|---|
| 36 | . K ORDIALOG($$PTR^ORCD("OR GTX NOW"),1)
|
|---|
| 37 | . S ORLOG=+$E($$NOW^XLFDT,1,12),FIRST=1
|
|---|
| 38 | XF2 . D DIALOG^ORCDLG Q:$G(ORQUIT)&FIRST K ORQUIT
|
|---|
| 39 | . D ACCEPT^ORCHECK(),DISPLAY^ORCDLG S X=$$OK^ORCDLG I X="^" S ORQUIT=1 Q
|
|---|
| 40 | . I X="E" K ORCHECK S FIRST=0 G XF2
|
|---|
| 41 | . I X="C" W !?10,"... order cancelled.",! Q
|
|---|
| 42 | . I X="P" D
|
|---|
| 43 | . . D EN^ORCSAVE W !?10,$S(ORIFN:"... order placed.",1:"ERROR"),!
|
|---|
| 44 | . . S:$G(ORIFN) ^TMP("ORNEW",$J,ORIFN,1)=""
|
|---|
| 45 | . . I '$D(^TMP("ORECALL",$J,ORDIALOG)) M ^(ORDIALOG)=ORDIALOG M:$D(^TMP("ORWORD",$J)) ^TMP("ORECALL",$J,ORDIALOG)=^TMP("ORWORD",$J) ;save 1st values
|
|---|
| 46 | XFQ D EXIT^ORCDPS1 ;X:$D(^ORD(101.41,ORDIALOG,4)) ^(4)
|
|---|
| 47 | K ^TMP("ORWORD",$J),^TMP("ORSIG",$J)
|
|---|
| 48 | D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | IN ; -- Kill extra values, Reset ID's/DD from Inpt dialog
|
|---|
| 52 | N P F P="START DATE/TIME","NOW" K ORDIALOG($$PTR(P),1)
|
|---|
| 53 | D DOSES("O")
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | OUT ; -- Kill extra values, Reset ID's/DD from Outpt dialog
|
|---|
| 57 | N P I '$O(ORDIALOG($$PTR("INSTRUCTIONS"),0)) D ;old sig in comments
|
|---|
| 58 | . N WP S WP=$$PTR("WORD PROCESSING 1") K ^TMP("ORSIG",$J)
|
|---|
| 59 | . M ^TMP("ORSIG",$J)=^TMP("ORWORD",$J,WP,1)
|
|---|
| 60 | . K ORDIALOG(WP,1),^TMP("ORWORD",$J,WP,1)
|
|---|
| 61 | F P="PATIENT INSTRUCTIONS","START DATE/TIME","DAYS SUPPLY","QUANTITY","REFILLS","ROUTING","SERVICE CONNECTED" K ORDIALOG($$PTR(P),1)
|
|---|
| 62 | I $G(ORDIALOG($$PTR("URGENCY"),1))=99 K ORDIALOG($$PTR("URGENCY"),1)
|
|---|
| 63 | D DOSES("I")
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | DOSES(TYPE) ; -- Convert doses to new TYPE, reset ID strings
|
|---|
| 67 | N PSOI,ORMED,PROMPT,DOSE,DRUG,I,X,DD,DRUG0,STR
|
|---|
| 68 | F I="DISPENSE DRUG","STRENGTH","DRUG NAME","SIG" K ORDIALOG($$PTR(I),1)
|
|---|
| 69 | S PSOI=+$P($G(^ORD(101.43,+$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1)),0)),U,2),ORMED=$P($G(^(0)),U)
|
|---|
| 70 | D DOSE^PSSORUTL(.ORDOSE,PSOI,TYPE,+ORVP) I $G(ORDOSE(1))=-1 K ORDOSE
|
|---|
| 71 | S PROMPT=$$PTR("INSTRUCTIONS"),DOSE=$$PTR("DOSE")
|
|---|
| 72 | S DRUG=$$PTR("DISPENSE DRUG") D D1^ORCDPS2
|
|---|
| 73 | S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D
|
|---|
| 74 | . K ORDIALOG(DOSE,I) S X=$G(ORDIALOG(PROMPT,I)) Q:'$L(X)
|
|---|
| 75 | . S X=$$UP^XLFSTR(X),DD=+$G(ORDIALOG(PROMPT,"LIST","D",X)) Q:'DD
|
|---|
| 76 | . S ORDIALOG(DOSE,I)=$TR($G(ORDOSE("DD",DD,X)),"^","&")
|
|---|
| 77 | . S ORDIALOG(DRUG,I)=DD,DRUG0=$G(ORDOSE("DD",DD))
|
|---|
| 78 | . S STR=$P(DRUG0,U,5)_$P(DRUG0,U,6)
|
|---|
| 79 | . I STR'>0 S:'$G(ORDOSE(1)) ORDIALOG($$PTR("DRUG NAME"),1)=$P(DRUG0,U) Q
|
|---|
| 80 | . I ORMED'[STR,TYPE="O"!'$G(ORDOSE(1)) S ORDIALOG($$PTR("STRENGTH"),1)=STR
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | CONT() ; -- Want to continue processing orders?
|
|---|
| 84 | N X,Y,DIR
|
|---|
| 85 | S DIR(0)="YA",DIR("A")="Do you want to continue transferring orders? ",DIR("B")="YES"
|
|---|
| 86 | S DIR("?")="Enter YES to continue transferring the remaining orders selected, or NO to quit this option."
|
|---|
| 87 | D ^DIR
|
|---|
| 88 | Q +Y
|
|---|
| 89 | ;
|
|---|
| 90 | SHOWSIG ; -- Show old sig for transfer in ^TMP("ORSIG",$J)
|
|---|
| 91 | N ORTX,I,X,ORMAX S ORMAX=72
|
|---|
| 92 | S I=0 F S I=$O(^TMP("ORSIG",$J,I)) Q:I'>0 S X=$G(^(I,0)) D:$L(X) TXT^ORCHTAB
|
|---|
| 93 | S I=0 F S I=$O(ORTX(I)) Q:I'>0 W !,$S(I=1:"(Sig: ",1:" ")_ORTX(I)
|
|---|
| 94 | W ")"
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | PTR(NAME) ; -- Returns pointer to OR GTX NAME
|
|---|
| 98 | Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
|
|---|
| 99 | ;
|
|---|
| 100 | REFILLS ; -- Request a refill for med orders
|
|---|
| 101 | ; ORNMBR = #,#,...,# of selected orders
|
|---|
| 102 | ;
|
|---|
| 103 | N ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORERR,ORQUIT,OROUT
|
|---|
| 104 | I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") G:'ORNMBR RFQ
|
|---|
| 105 | D FREEZE^ORCMENU S VALMBCK="R"
|
|---|
| 106 | S ORNP=$$PROVIDER^ORCMENU1 G:ORNP="^" RFQ
|
|---|
| 107 | S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 G:ORL="^" RFQ
|
|---|
| 108 | S OROUT=$$ROUTING G:OROUT="^" RFQ
|
|---|
| 109 | F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
|
|---|
| 110 | . S IDX=$G(^TMP("OR",$J,"CURRENT","IDX",NMBR)),ORIFN=+$P(IDX,U,4)
|
|---|
| 111 | . Q:'ORIFN I '$D(^OR(100,ORIFN,0)) W !,"Invalid order number!" H 2 Q
|
|---|
| 112 | . S ORDITM=$$ORDITEM^ORCACT(ORIFN) D SUBHDR^ORCACT(ORDITM)
|
|---|
| 113 | . I '$$VALID^ORCACT0(ORIFN,"RF",.ORERR) W !,ORERR H 2 Q
|
|---|
| 114 | . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !,$P(ORLK,U,2) H 2 Q
|
|---|
| 115 | . D REF^ORMBLDPS(ORIFN,OROUT),UNLK1^ORX2(+ORIFN)
|
|---|
| 116 | . W !?10,"... refill requested.",$$RETURN
|
|---|
| 117 | RFQ Q
|
|---|
| 118 | ;
|
|---|
| 119 | RETURN() ; -- press return to cont
|
|---|
| 120 | N X W !,"Press <return> to continue ..." R X:DTIME
|
|---|
| 121 | Q ""
|
|---|
| 122 | ;
|
|---|
| 123 | ROUTING() ; -- Routing for refill
|
|---|
| 124 | N X,Y,DIR S DIR(0)="SAM^W:WINDOW;M:MAIL;C:ADMINISTERED IN CLINIC;"
|
|---|
| 125 | S DIR("A")="Routing: ",DIR("B")=$S($D(^PSX(550,"C")):"MAIL",1:"WINDOW")
|
|---|
| 126 | S DIR("?")="Select how the patient is to receive this refill, by mail or at the window or in the clinic"
|
|---|
| 127 | D ^DIR S:$D(DTOUT)!(X["^") Y="^"
|
|---|
| 128 | Q Y
|
|---|
| 129 | ;
|
|---|
| 130 | NW ; -- Order New Medication from Meds tab
|
|---|
| 131 | ; Requires ORDIALOG = name of pkg dialog
|
|---|
| 132 | ; OREVENT = event, if delaying orders
|
|---|
| 133 | ; OREVENT("TS") = treating spec, if admission or transfer
|
|---|
| 134 | N ORPTLK G:'$L($G(ORDIALOG)) NWQ
|
|---|
| 135 | S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q
|
|---|
| 136 | D FREEZE^ORCMENU S VALMBCK="R"
|
|---|
| 137 | S ORNP=$$PROVIDER^ORCMENU1 G:ORNP="^" NWQ
|
|---|
| 138 | I '$G(ORL) S ORL=$S($G(OREVENT):$$LOC^OREVNTX(OREVENT),1:$$LOCATION^ORCMENU1) G:ORL["^" NWQ
|
|---|
| 139 | S ORDIALOG=$O(^ORD(101.41,"AB",$E(ORDIALOG,1,63),0)) G:'ORDIALOG NWQ
|
|---|
| 140 | D ADD^ORCDLG,REBLD^ORCMENU:$D(^TMP("ORNEW",$J))
|
|---|
| 141 | K ORDIALOG,^TMP("ORWORD",$J),^TMP("ORECALL",$J) S VALMBCK="R"
|
|---|
| 142 | NWQ D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders
|
|---|
| 143 | Q
|
|---|
