GMTSXQ13 ; SLC/JER - XQORO for Export w/Health Summary ;1/10/92 15:12
;;2.5;Health Summary;;Dec 16, 1992
XQORO ; SLC/KCM - Order Entry Calls ;7/26/91 09:13 ;
;;6.52;Copyright 1990, DVA;
ENTRY ;Setup initial 'add orders' context
Q:$D(ORNOAD) ;Flag for MAS protocols Phase out by 11/90
I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
S XQORQUIT=1 Q:'$D(ORACTION) Q:ORACTION S (ORACTION,OREND)=0
D ADD^OR1 I OREND!$D(ORPTLK) S OREND=0 Q
S ^UTILITY("XQORS",$J,0,"CTXT","ADD")=XQORS,^UTILITY("XQORS",$J,XQORS,"CTX","AD")=""
K XQORQUIT Q
EVERY ;Setup for every new node in 'add orders' context
Q:$D(ORNOAD) ;Flag for MAS protocols Phase out by 11/90
I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
K ORIFN,ORCOST,ORIT,ORSTRT,ORSTOP,ORTO,ORPURG,ORTX,ORSAMP,ORSPEC,ORSTS,ORPK,ORLOG,ORPCL,OR,ORZ,ORNS
D RSTR I $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^")="Q" S XQORM("H")="S ORUIEN=XQORNOD D OE^ORUHDR K ORUIEN"
;I "OL"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^") S X="(for "_ORPNM_")" W !?(40-($L(X)\2)),X
I $P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^",3),"OL"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^"),$P(^ORD(100.99,1,0),"^",11) W !!,"<Orders for ",ORPNM,">"
S:$D(@(^UTILITY("XQORS",$J,XQORS,"REF")_"0)")) ORNS=$P(^(0),"^",12),ORTX=$P(^(0),"^",2)
I $S(ORNS:$S($D(^ORD(100.99,1,5,ORNS,0)):$S($P(^(0),"^",3):0,1:1),1:1),1:1) W *7,!,$P(XQORNOD(0),"^",3)_" not setup to order from OE/RR",!,"(Package not setup)" S XQORQUIT=1 D READ^ORUTL Q
I ORNS,'$D(ORUP(ORNS)) S ORUP(ORNS)="" I $D(^ORD(100.99,1,5,ORNS,3)),$L(^(3)) X ^(3)
S OREND=0
Q
EXIT ;When done adding, accept orders and transact them
I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
D RSTR,AFT^OR1,RSTR K ^UTILITY("XQORS",$J,0,"CTXT","ADD"),^UTILITY("XQORS",$J,XQORS,"CTX","AD") S ORACTION=""
Q
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)
S:$D(^UTILITY("XQORS",$J,0,"CTXT","ADD")) ORACTION=0
Q
WARN W !,*7,"OE/RR is not installed. Options of this type should not be used.",*7,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXQ13 2149 printed Nov 22, 2024@17:11:22 Page 2
GMTSXQ13 ; SLC/JER - XQORO for Export w/Health Summary ;1/10/92 15:12
+1 ;;2.5;Health Summary;;Dec 16, 1992
XQORO ; SLC/KCM - Order Entry Calls ;7/26/91 09:13 ;
+1 ;;6.52;Copyright 1990, DVA;
ENTRY ;Setup initial 'add orders' context
+1 ;Flag for MAS protocols Phase out by 11/90
if $DATA(ORNOAD)
QUIT
+2 IF $SELECT($DATA(^DD(100,0,"VR")):^("VR")<1.89,1:1)
DO WARN
QUIT
+3 SET XQORQUIT=1
if '$DATA(ORACTION)
QUIT
if ORACTION
QUIT
SET (ORACTION,OREND)=0
+4 DO ADD^OR1
IF OREND!$DATA(ORPTLK)
SET OREND=0
QUIT
+5 SET ^UTILITY("XQORS",$JOB,0,"CTXT","ADD")=XQORS
SET ^UTILITY("XQORS",$JOB,XQORS,"CTX","AD")=""
+6 KILL XQORQUIT
QUIT
EVERY ;Setup for every new node in 'add orders' context
+1 ;Flag for MAS protocols Phase out by 11/90
if $DATA(ORNOAD)
QUIT
+2 IF $SELECT($DATA(^DD(100,0,"VR")):^("VR")<1.89,1:1)
DO WARN
QUIT
+3 KILL ORIFN,ORCOST,ORIT,ORSTRT,ORSTOP,ORTO,ORPURG,ORTX,ORSAMP,ORSPEC,ORSTS,ORPK,ORLOG,ORPCL,OR,ORZ,ORNS
+4 DO RSTR
IF $PIECE(^UTILITY("XQORS",$JOB,XQORS,"FLG"),"^")="Q"
SET XQORM("H")="S ORUIEN=XQORNOD D OE^ORUHDR K ORUIEN"
+5 ;I "OL"[$P(^UTILITY("XQORS",$J,XQORS,"FLG"),"^") S X="(for "_ORPNM_")" W !?(40-($L(X)\2)),X
+6 IF $PIECE(^UTILITY("XQORS",$JOB,XQORS,"FLG"),"^",3)
IF "OL"[$PIECE(^UTILITY("XQORS",$JOB,XQORS,"FLG"),"^")
IF $PIECE(^ORD(100.99,1,0),"^",11)
WRITE !!,"<Orders for ",ORPNM,">"
+7 if $DATA(@(^UTILITY("XQORS",$JOB,XQORS,"REF")_"0)"))
SET ORNS=$PIECE(^(0),"^",12)
SET ORTX=$PIECE(^(0),"^",2)
+8 IF $SELECT(ORNS:$SELECT($DATA(^ORD(100.99,1,5,ORNS,0)):$SELECT($PIECE(^(0),"^",3):0,1:1),1:1),1:1)
WRITE *7,!,$PIECE(XQORNOD(0),"^",3)_" not setup to order from OE/RR",!,"(Package not setup)"
SET XQORQUIT=1
DO READ^ORUTL
QUIT
+9 IF ORNS
IF '$DATA(ORUP(ORNS))
SET ORUP(ORNS)=""
IF $DATA(^ORD(100.99,1,5,ORNS,3))
IF $LENGTH(^(3))
XECUTE ^(3)
+10 SET OREND=0
+11 QUIT
EXIT ;When done adding, accept orders and transact them
+1 IF $SELECT($DATA(^DD(100,0,"VR")):^("VR")<1.89,1:1)
DO WARN
QUIT
+2 DO RSTR
DO AFT^OR1
DO RSTR
KILL ^UTILITY("XQORS",$JOB,0,"CTXT","ADD"),^UTILITY("XQORS",$JOB,XQORS,"CTX","AD")
SET ORACTION=""
+3 QUIT
RSTR SET ORVP=$PIECE(OROLD,"^")
SET ORPV=$PIECE(OROLD,"^",2)
SET ORL=$PIECE(OROLD,"^",3)
SET ORTS=$PIECE(OROLD,"^",4)
SET ORL(0)=$PIECE(OROLD,"^",5)
SET ORL(1)=$PIECE(OROLD,"^",6)
SET ORDUZ=$PIECE(OROLD,"^",7)
SET ORNP=$PIECE(OROLD,"^",8)
SET ORL(2)=$PIECE(OROLD,"^",9)
+1 if $DATA(^UTILITY("XQORS",$JOB,0,"CTXT","ADD"))
SET ORACTION=0
+2 QUIT
WARN WRITE !,*7,"OE/RR is not installed. Options of this type should not be used.",*7,!
+1 QUIT
