- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMED.m
r613 r623 1 ORCMED ;SLC/MKB-Medication actions ;03/19/072 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,7,38,48,94,141,178,190,195,243**;Dec 17, 1997;Build 242 3 XFER 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 XF1 25 26 27 28 29 30 31 32 33 34 35 36 37 38 XF2 39 40 41 42 43 44 45 46 XFQ 47 48 49 50 51 IN 52 53 54 55 56 OUT 57 58 59 60 61 62 63 64 65 66 DOSES(TYPE) 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 CONT() 84 85 86 87 88 89 90 SHOWSIG 91 92 93 94 95 96 97 PTR(NAME) 98 99 100 REFILLS 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 RFQ 118 119 RETURN() 120 121 122 123 ROUTING() 124 125 126 127 128 129 130 NW 131 132 133 134 135 136 137 138 139 140 141 142 NWQ 143 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
Note:
See TracChangeset
for help on using the changeset viewer.
