Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCMENU1

ORCMENU1.m

Go to the documentation of this file.
  1. ORCMENU1 ;SLC/MKB-Add Orders cont ;2/7/97 15:41
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,36,55,48,92**;Dec 17, 1997
  1. ORDCHK ; -- Order Checking [called from ORCSIGN]
  1. ; Returns ORQUIT=1 if ^ or timeout
  1. N ORCHECK,ORIFN,ORY,ORTX,ORIGVIEW
  1. D SESSION^ORCHECK Q:'$G(ORCHECK)
  1. W !,"Unsigned orders with order checks:"
  1. S (ORIFN,ORY)=0 F S ORIFN=$O(ORCHECK(ORIFN)) Q:ORIFN'>0 D
  1. . S ORY=ORY+1,ORY(ORY)=ORIFN,ORIGVIEW=2 D TEXT^ORQ12(.ORTX,ORIFN,70)
  1. . W !!,$J(ORY,3)_". "_$G(ORTX(1))_$S($O(ORTX(1)):" ...",1:"")
  1. . D LIST^ORCHECK(ORIFN)
  1. OC1 I $$CANCEL^ORCHECK D ; cancel order(s)
  1. . N X,Y,Z,DIR,NMBR,DIK,DA,ORI S:ORY=1 Y=1
  1. . 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))
  1. . S NMBR=Y,DIK="^OR(100,"
  1. . F ORI=1:1:$L(NMBR,",") S X=$P(NMBR,",",ORI) I X D
  1. . . S DA=+$G(ORY(X)) Q:'DA D ^DIK,UNLK1^ORX2(DA)
  1. . . K ORES(DA_";1"),^TMP("ORNEW",$J,DA,1),ORCHECK(DA),ORY(X) S ORY=ORY-1
  1. . W !?10,"... orders cancelled.",!
  1. OC2 Q:ORY'>0 ; all orders cancelled
  1. 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
  1. I $G(ORCHECK("OK"))="^" S ORQUIT=1 K ORCHECK("OK") ; save unsigned
  1. S ORIFN=0 F S ORIFN=$O(ORCHECK(ORIFN)) Q:ORIFN'>0 D OC^ORCSAVE2
  1. Q
  1. ;
  1. LOCATION(ORQ,ORB,ORS) ; -- Returns patient location
  1. ; Optional: ORQ = 1 if not required
  1. ; ORB = Default value in vptr format
  1. ; ORS = String of location types to allow
  1. ;
  1. N X,Y,DIR S:'$L($G(ORS)) ORS="CZW" ;assume Clinic, Other, Ward
  1. S DIR(0)="PA"_$S($G(ORQ):"O",1:"")_"^44:AEQM",DIR("A")="Patient Location: "
  1. S DIR("S")="I ORS[$P(^(0),U,3),'$P($G(^(""OOS"")),""^"")"
  1. S DIR("?")="Enter the patient's current location."
  1. S:$G(ORB) DIR("B")=$P($G(^SC(+ORB,0)),U)
  1. LOC1 D ^DIR S:Y>0 Y=+Y_";SC(" S:Y'>0 Y="^"
  1. I Y,'$$ACTLOC^ORWU(+Y) W $C(7),!,"This location is inactive!" G LOC1
  1. Q Y
  1. ;
  1. PROVIDER(ASK) ; -- Return ordering provider [ASK=1: force prompting]
  1. N X,Y,DIC,DFN,%
  1. I '$G(ASK),$D(^XUSEC("ORES",DUZ)),$D(^XUSEC("PROVIDER",DUZ)) D Q Y
  1. . S Y=DUZ Q:'$G(ORNP) Q:ORNP=DUZ ;no change, else show current prov
  1. . S Y=+ORNP W !,"Requesting CLINICIAN: "_$P($G(^VA(200,Y,0)),U) H 1
  1. S Y=$$OUTPTPR^SDUTL3(+ORVP) W:Y !,"Primary Care Physician is "_$P(Y,U,2),!
  1. 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
  1. P S DIC=200,DIC(0)="AEQM",DIC("A")="Requesting CLINICIAN: " ;D=AK.PROVIDER
  1. S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U)))"
  1. D ^DIC S:Y>0 Y=+Y I Y'>0 S Y="^" G PQ
  1. I Y,'$$PROVIDER^XUSER(+Y) W $C(7),!,"This provider is no longer active!" G P ;IA#2343
  1. 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
  1. 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
  1. PQ Q Y
  1. ;
  1. SPEC(EVENT) ; -- Return treating specialty
  1. N X,Y,DIC S:'$L($G(EVENT)) EVENT="" D FULL^VALM1 S VALMBCK="R"
  1. S DIC="^DIC(45.7,",DIC(0)="AEQM",DIC("S")="I $$ACTIVE^DGACT(45.7,Y)",D="B^AHN"
  1. S DIC("A")=$S(EVENT="A":"Admit to Specialty: ",EVENT="T":"Transfer to Specialty: ",1:"Treating Specialty: ")
  1. D MIX^DIC1 S:$D(DTOUT)!$D(DUOUT)!(Y'>0) Y="^"
  1. Q Y
  1. ;
  1. CHANGE ; -- Change location and/or provider
  1. N ORRV,ORX,ORCHNGD I $D(^TMP("ORNEW",$J)) D
  1. . W !!,"There are new orders for this patient from the current location or provider!"
  1. . H 1 S ORRV=1 D EN^ORCMENU2,NOTIF^ORCMENU2 ;EX^ORCMENU2 in Exit Action
  1. D FULL^VALM1 S VALMBCK="R",ORCHNGD=0
  1. W !!,"NOTE: You may now select a new ordering location and/or provider."
  1. W !,"===== These changes will remain in effect until the chart is closed unless",!," these values are changed again!",!,$C(7)
  1. S ORX=$$LOCATION(0,ORL) Q:ORX="^"
  1. I ORX,ORX'=ORL S ORL=ORX,ORL(0)=$P($G(^SC(+ORL,0)),U),ORL(1)="",ORCHNGD=1 K ^TMP("ORNEW",$J),VALMHDR
  1. S ORX=$$PROVIDER(1) I ORX,ORX'=$G(ORNP) S ORNP=ORX,ORCHNGD=1
  1. W !?10,"... "_$S(ORCHNGD:"changes now effective!",1:"nothing changed!")
  1. H 1 Q