| [613] | 1 | ORCMENU1 ;SLC/MKB-Add Orders cont ;2/7/97 15:41
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,36,55,48,92**;Dec 17, 1997
|
|---|
| 3 | ORDCHK ; -- Order Checking [called from ORCSIGN]
|
|---|
| 4 | ; Returns ORQUIT=1 if ^ or timeout
|
|---|
| 5 | N ORCHECK,ORIFN,ORY,ORTX,ORIGVIEW
|
|---|
| 6 | D SESSION^ORCHECK Q:'$G(ORCHECK)
|
|---|
| 7 | W !,"Unsigned orders with order checks:"
|
|---|
| 8 | S (ORIFN,ORY)=0 F S ORIFN=$O(ORCHECK(ORIFN)) Q:ORIFN'>0 D
|
|---|
| 9 | . S ORY=ORY+1,ORY(ORY)=ORIFN,ORIGVIEW=2 D TEXT^ORQ12(.ORTX,ORIFN,70)
|
|---|
| 10 | . W !!,$J(ORY,3)_". "_$G(ORTX(1))_$S($O(ORTX(1)):" ...",1:"")
|
|---|
| 11 | . D LIST^ORCHECK(ORIFN)
|
|---|
| 12 | OC1 I $$CANCEL^ORCHECK D ; cancel order(s)
|
|---|
| 13 | . N X,Y,Z,DIR,NMBR,DIK,DA,ORI S:ORY=1 Y=1
|
|---|
| 14 | . I ORY'=1 S DIR(0)="LA^1:"_ORY,DIR("A")="Select orders: ",DIR("?")="Enter the orders you wish to cancel, as a range or list of numbers" D ^DIR Q:$D(DTOUT)!($D(DUOUT))
|
|---|
| 15 | . S NMBR=Y,DIK="^OR(100,"
|
|---|
| 16 | . F ORI=1:1:$L(NMBR,",") S X=$P(NMBR,",",ORI) I X D
|
|---|
| 17 | . . S DA=+$G(ORY(X)) Q:'DA D ^DIK,UNLK1^ORX2(DA)
|
|---|
| 18 | . . K ORES(DA_";1"),^TMP("ORNEW",$J,DA,1),ORCHECK(DA),ORY(X) S ORY=ORY-1
|
|---|
| 19 | . W !?10,"... orders cancelled.",!
|
|---|
| 20 | OC2 Q:ORY'>0 ; all orders cancelled
|
|---|
| 21 | S ORIFN=0 F S ORIFN=$O(ORCHECK(ORIFN)) Q:ORIFN'>0 I $D(ORCHECK(ORIFN,1)) W !!,"Critical order checks remain that require a justification." S ORCHECK("OK")=$$REASON^ORCHECK Q
|
|---|
| 22 | I $G(ORCHECK("OK"))="^" S ORQUIT=1 K ORCHECK("OK") ; save unsigned
|
|---|
| 23 | S ORIFN=0 F S ORIFN=$O(ORCHECK(ORIFN)) Q:ORIFN'>0 D OC^ORCSAVE2
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | LOCATION(ORQ,ORB,ORS) ; -- Returns patient location
|
|---|
| 27 | ; Optional: ORQ = 1 if not required
|
|---|
| 28 | ; ORB = Default value in vptr format
|
|---|
| 29 | ; ORS = String of location types to allow
|
|---|
| 30 | ;
|
|---|
| 31 | N X,Y,DIR S:'$L($G(ORS)) ORS="CZW" ;assume Clinic, Other, Ward
|
|---|
| 32 | S DIR(0)="PA"_$S($G(ORQ):"O",1:"")_"^44:AEQM",DIR("A")="Patient Location: "
|
|---|
| 33 | S DIR("S")="I ORS[$P(^(0),U,3),'$P($G(^(""OOS"")),""^"")"
|
|---|
| 34 | S DIR("?")="Enter the patient's current location."
|
|---|
| 35 | S:$G(ORB) DIR("B")=$P($G(^SC(+ORB,0)),U)
|
|---|
| 36 | LOC1 D ^DIR S:Y>0 Y=+Y_";SC(" S:Y'>0 Y="^"
|
|---|
| 37 | I Y,'$$ACTLOC^ORWU(+Y) W $C(7),!,"This location is inactive!" G LOC1
|
|---|
| 38 | Q Y
|
|---|
| 39 | ;
|
|---|
| 40 | PROVIDER(ASK) ; -- Return ordering provider [ASK=1: force prompting]
|
|---|
| 41 | N X,Y,DIC,DFN,%
|
|---|
| 42 | I '$G(ASK),$D(^XUSEC("ORES",DUZ)),$D(^XUSEC("PROVIDER",DUZ)) D Q Y
|
|---|
| 43 | . S Y=DUZ Q:'$G(ORNP) Q:ORNP=DUZ ;no change, else show current prov
|
|---|
| 44 | . S Y=+ORNP W !,"Requesting CLINICIAN: "_$P($G(^VA(200,Y,0)),U) H 1
|
|---|
| 45 | S Y=$$OUTPTPR^SDUTL3(+ORVP) W:Y !,"Primary Care Physician is "_$P(Y,U,2),!
|
|---|
| 46 | I $$GET^XPAR("ALL","ORPF DEFAULT PROVIDER") S:$G(ORNP) DIC("B")=$P($G(^VA(200,+ORNP,0)),U) I '$G(ORNP),$D(^XUSEC("PROVIDER",DUZ)),'$$GET^XPAR("ALL","ORPF RESTRICT REQUESTOR")!$D(^XUSEC("ORES",DUZ)) S DIC("B")=DUZ
|
|---|
| 47 | P S DIC=200,DIC(0)="AEQM",DIC("A")="Requesting CLINICIAN: " ;D=AK.PROVIDER
|
|---|
| 48 | S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))"
|
|---|
| 49 | D ^DIC S:Y>0 Y=+Y I Y'>0 S Y="^" G PQ
|
|---|
| 50 | I Y,'$$PROVIDER^XUSER(+Y) W $C(7),!,"This provider is no longer active!" G P ;IA#2343
|
|---|
| 51 | I +Y=DUZ S X=$$GET^XPAR("ALL","ORPF RESTRICT REQUESTOR") I X,$S($D(^XUSEC("ORELSE",DUZ)):1,$D(^XUSEC("OREMAS",DUZ))&(X=2):1,1:0) W !!,"You are not allowed to choose yourself as the Requesting Clinician",! G P
|
|---|
| 52 | S X=$$GET^XPAR("ALL","ORPF CONFIRM PROVIDER") I X G:(X=2&($D(^XUSEC("ORES",DUZ)))) PQ W !!,"Requesting Clinician: "_$P(^VA(200,+Y,0),"^")_" Are you sure" S %=$S(X=3:1,1:2) D YN^DICN I %'=1 G P
|
|---|
| 53 | PQ Q Y
|
|---|
| 54 | ;
|
|---|
| 55 | SPEC(EVENT) ; -- Return treating specialty
|
|---|
| 56 | N X,Y,DIC S:'$L($G(EVENT)) EVENT="" D FULL^VALM1 S VALMBCK="R"
|
|---|
| 57 | S DIC="^DIC(45.7,",DIC(0)="AEQM",DIC("S")="I $$ACTIVE^DGACT(45.7,Y)",D="B^AHN"
|
|---|
| 58 | S DIC("A")=$S(EVENT="A":"Admit to Specialty: ",EVENT="T":"Transfer to Specialty: ",1:"Treating Specialty: ")
|
|---|
| 59 | D MIX^DIC1 S:$D(DTOUT)!$D(DUOUT)!(Y'>0) Y="^"
|
|---|
| 60 | Q Y
|
|---|
| 61 | ;
|
|---|
| 62 | CHANGE ; -- Change location and/or provider
|
|---|
| 63 | N ORRV,ORX,ORCHNGD I $D(^TMP("ORNEW",$J)) D
|
|---|
| 64 | . W !!,"There are new orders for this patient from the current location or provider!"
|
|---|
| 65 | . H 1 S ORRV=1 D EN^ORCMENU2,NOTIF^ORCMENU2 ;EX^ORCMENU2 in Exit Action
|
|---|
| 66 | D FULL^VALM1 S VALMBCK="R",ORCHNGD=0
|
|---|
| 67 | W !!,"NOTE: You may now select a new ordering location and/or provider."
|
|---|
| 68 | W !,"===== These changes will remain in effect until the chart is closed unless",!," these values are changed again!",!,$C(7)
|
|---|
| 69 | S ORX=$$LOCATION(0,ORL) Q:ORX="^"
|
|---|
| 70 | I ORX,ORX'=ORL S ORL=ORX,ORL(0)=$P($G(^SC(+ORL,0)),U),ORL(1)="",ORCHNGD=1 K ^TMP("ORNEW",$J),VALMHDR
|
|---|
| 71 | S ORX=$$PROVIDER(1) I ORX,ORX'=$G(ORNP) S ORNP=ORX,ORCHNGD=1
|
|---|
| 72 | W !?10,"... "_$S(ORCHNGD:"changes now effective!",1:"nothing changed!")
|
|---|
| 73 | H 1 Q
|
|---|
