source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQORO.m@ 1639

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

initial load of WorldVistAEHR
File size: 2.8 KB
RevLine 
[613]1XQORO ; SLC/KCM - Order Entry Calls ;08/24/98 12:36
2 ;;8.0;KERNEL;**48,56,94**;Jul 10, 1995
3ENTRY ;Setup initial 'add orders' context
4 Q:$D(ORNOAD) ;Flag for MAS protocols Phase out by 11/90
5 I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
6 I $D(^ORD(100.99,1,0)),$P(^(0),"^",16) S DIROUT="^^" W !!,$C(7),"OE/RR Software is currently being updated. Access temporarily denied.",! Q
7 ; I $D(XRTL) D T0^%ZOSV ; Start RT Log
8 S XQORQUIT=1 Q:'$D(ORACTION) Q:ORACTION S (ORGY,ORACTION,OREND)=0
9 D ADD^OR1 I OREND!$D(ORPTLK) D:OREND PT1^ORX2 S OREND=0 Q
10 S ^TMP("XQORS",$J,0,"CTXT","ADD")=XQORS,^TMP("XQORS",$J,XQORS,"CTX","AD")=""
11 K XQORQUIT Q
12EVERY ;Setup for every new node in 'add orders' context
13 I $D(^TMP("ORPAT",$J)),^($J)'=ORVP S XQORPOP=1 W !!,"Unable to process orders for "_$P(^DPT(+ORVP,0),"^")_" until",!,"the ordering session for "_$P(^DPT(+^TMP("ORPAT",$J),0),"^"),!,"has been completed." D READ^ORUTL Q
14 Q:$D(ORNOAD) ;Flag for MAS protocols Phase out by 11/90
15 I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
16 I $D(^ORD(100.99,1,0)),$P(^(0),"^",16) S DIROUT="^^" W !!,$C(7),"OE/RR Software is currently being updated. Access temporarily denied.",! Q
17 K ORIFN,ORCOST,ORIT,ORSTRT,ORSTOP,ORTO,ORPURG,ORTX,ORSTS,ORPK,ORLOG,ORPCL,OR,ORZ,ORNS
18 D RSTR I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^")="Q",($G(^ORD(101,+XQORNOD,26))'["^OR") S XQORM("H")="S ORUIEN=XQORNOD D OE^ORUHDR K ORUIEN" D:$L($T(^ORGKEY)) SET^ORGKEY
19 ;I "OL"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^") S X="(for "_ORPNM_")" W !?(40-($L(X)\2)),X
20 I $P(^TMP("XQORS",$J,XQORS,"FLG"),"^",3),"OL"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^"),$P(^ORD(100.99,1,0),"^",11) W !!,"<Orders for ",ORPNM,">"
21 S:$D(@(^TMP("XQORS",$J,XQORS,"REF")_"0)")) ORNS=$P(^(0),"^",12),ORTX=$P(^(0),"^",2)
22 I $S(ORNS:$S($D(^ORD(100.99,1,20,ORNS,0)):$S($P(^(0),"^",2):0,1:1),$D(^ORD(100.99,1,5,ORNS,0)):$S($P(^(0),"^",3):0,1:1),1:1),1:1) W $C(7),!,"This item is not setup to order from OE/RR",!,"(Package not setup)" S XQORQUIT=1 D READ^ORUTL Q
23 I ORNS,'$D(ORUP(ORNS)) S ORUP(ORNS)="" I $D(^ORD(100.99,1,5,ORNS,3)),$L(^(3)) X ^(3)
24 S OREND=0 K ORNS
25 Q
26EXIT ;When done adding, accept orders and transact them
27 N XRTN
28 I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
29 D RSTR,AFT^OR1,RSTR K ^TMP("XQORS",$J,0,"CTXT","ADD"),^TMP("XQORS",$J,XQORS,"CTX","AD"),^TMP("ORPAT",$J) S (ORGY,ORACTION)=""
30 D PT1^ORX2
31 ; I $D(XRT0) S XRTN="ADD ORDERS" D T1^%ZOSV ; Stop RT Log
32 Q
33RSTR S ORVP=$P(OROLD,"^"),ORPV=$P(OROLD,"^",2),ORL=$P(OROLD,"^",3),ORTS=$P(OROLD,"^",4),ORL(0)=$P(OROLD,"^",5),ORL(1)=$P(OROLD,"^",6),ORDUZ=$P(OROLD,"^",7),ORNP=$P(OROLD,"^",8),ORL(2)=$P(OROLD,"^",9),OROLOC=$P(OROLD,"^",10)
34 S OROLOC=$S($L($P(OROLD,"^",10)):$P(OROLD,"^",10),1:ORL),DFN=$P(OROLD,"^",11) S:$D(^TMP("XQORS",$J,0,"CTXT","ADD")) (ORGY,ORACTION)=0
35 Q
36WARN W !,$C(7),"OE/RR is not installed. Options of this type should not be used.",$C(7),!
37 Q
Note: See TracBrowser for help on using the repository browser.