source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMENU1.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1ORCMENU1 ;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
3ORDCHK ; -- 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)
12OC1 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.",!
20OC2 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 ;
26LOCATION(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)
36LOC1 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 ;
40PROVIDER(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
47P 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
53PQ Q Y
54 ;
55SPEC(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 ;
62CHANGE ; -- 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
Note: See TracBrowser for help on using the repository browser.