| [613] | 1 | VALMXQ15 ; alb/mjk - XQORO for export with LM v1 ; 3/30/93
|
|---|
| 2 | ;;1;List Manager;**2**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | XQORO ; SLC/KCM - Order Entry Calls ;12/14/92 09:46
|
|---|
| 6 | ;;6.7;Sidewinder;**14,15**;Jan 08, 1993
|
|---|
| 7 | ENTRY ;Setup initial 'add orders' context
|
|---|
| 8 | Q:$D(ORNOAD) ;Flag for MAS protocols Phase out by 11/90
|
|---|
| 9 | I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
|
|---|
| 10 | I $D(^ORD(100.99,1,0)),$P(^(0),"^",16) S DIROUT="^^" W !!,*7,"OE/RR Software is currently being updated. Access temporarily denied.",! Q
|
|---|
| 11 | I $D(XRTL) D T0^%ZOSV ; Start RT Log
|
|---|
| 12 | S XQORQUIT=1 Q:'$D(ORACTION) Q:ORACTION S (ORGY,ORACTION,OREND)=0
|
|---|
| 13 | D ADD^OR1 I OREND!$D(ORPTLK) S OREND=0 Q
|
|---|
| 14 | S ^TMP("XQORS",$J,0,"CTXT","ADD")=XQORS,^TMP("XQORS",$J,XQORS,"CTX","AD")=""
|
|---|
| 15 | K XQORQUIT Q
|
|---|
| 16 | EVERY ;Setup for every new node in 'add orders' context
|
|---|
| 17 | Q:$D(ORNOAD) ;Flag for MAS protocols Phase out by 11/90
|
|---|
| 18 | I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
|
|---|
| 19 | I $D(^ORD(100.99,1,0)),$P(^(0),"^",16) S DIROUT="^^" W !!,*7,"OE/RR Software is currently being updated. Access temporarily denied.",! Q
|
|---|
| 20 | K ORIFN,ORCOST,ORIT,ORSTRT,ORSTOP,ORTO,ORPURG,ORTX,ORSTS,ORPK,ORLOG,ORPCL,OR,ORZ,ORNS
|
|---|
| 21 | 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
|
|---|
| 22 | ;I "OL"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^") S X="(for "_ORPNM_")" W !?(40-($L(X)\2)),X
|
|---|
| 23 | 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,">"
|
|---|
| 24 | S:$D(@(^TMP("XQORS",$J,XQORS,"REF")_"0)")) ORNS=$P(^(0),"^",12),ORTX=$P(^(0),"^",2)
|
|---|
| 25 | 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 *7,!,"This item is not setup to order from OE/RR",!,"(Package not setup)" S XQORQUIT=1 D READ^ORUTL Q
|
|---|
| 26 | I ORNS,'$D(ORUP(ORNS)) S ORUP(ORNS)="" I $D(^ORD(100.99,1,5,ORNS,3)),$L(^(3)) X ^(3)
|
|---|
| 27 | S OREND=0 K ORNS
|
|---|
| 28 | Q
|
|---|
| 29 | EXIT ;When done adding, accept orders and transact them
|
|---|
| 30 | N XRTN
|
|---|
| 31 | I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
|
|---|
| 32 | D RSTR,AFT^OR1,RSTR K ^TMP("XQORS",$J,0,"CTXT","ADD"),^TMP("XQORS",$J,XQORS,"CTX","AD") S (ORGY,ORACTION)=""
|
|---|
| 33 | D PT1^ORX2
|
|---|
| 34 | I $D(XRT0) S XRTN="ADD ORDERS" D T1^%ZOSV ; Stop RT Log
|
|---|
| 35 | Q
|
|---|
| 36 | RSTR 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)
|
|---|
| 37 | 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
|
|---|
| 38 | Q
|
|---|
| 39 | WARN W !,*7,"OE/RR is not installed. Options of this type should not be used.",*7,!
|
|---|
| 40 | Q
|
|---|
