- VALMXQ15 ; alb/mjk - XQORO for export with LM v1 ; 3/30/93
- ;;1;List Manager;;Aug 13, 1993
- ;
- ;
- XQORO ; SLC/KCM - Order Entry Calls ;12/14/92 09:46
- ;;6.7;Sidewinder;**14,15**;Jan 08, 1993
- 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
- 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
- I $D(XRTL) D T0^%ZOSV ; Start RT Log
- I $L($T(LOGRSRC^%ZOSV)),XQORNOD["ORD(101,",$P(^ORD(101,+XQORNOD,0),"^",4)'="M",$P(^(0),"^",4)'="Q" D:'$D(XQXFLG) ABT^XQ12 I $P(XQXFLG,"^",2)=1 S ORPRFRM="*"_$P(^ORD(101,+XQORNOD,0),"^") D LOGRSRC^%ZOSV("*"_ORPRFRM)
- S XQORQUIT=1 Q:'$D(ORACTION) Q:ORACTION S (ORGY,ORACTION,OREND)=0
- D ADD^OR1 I OREND!$D(ORPTLK) S OREND=0 Q
- S ^TMP("XQORS",$J,0,"CTXT","ADD")=XQORS,^TMP("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
- 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
- K ORIFN,ORCOST,ORIT,ORSTRT,ORSTOP,ORTO,ORPURG,ORTX,ORSTS,ORPK,ORLOG,ORPCL,OR,ORZ,ORNS
- 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
- ;I "OL"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^") S X="(for "_ORPNM_")" W !?(40-($L(X)\2)),X
- 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,">"
- S:$D(@(^TMP("XQORS",$J,XQORS,"REF")_"0)")) ORNS=$P(^(0),"^",12),ORTX=$P(^(0),"^",2)
- 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
- I ORNS,'$D(ORUP(ORNS)) S ORUP(ORNS)="" I $D(^ORD(100.99,1,5,ORNS,3)),$L(^(3)) X ^(3)
- S OREND=0 K ORNS
- Q
- EXIT ;When done adding, accept orders and transact them
- N XRTN
- I $S($D(^DD(100,0,"VR")):^("VR")<1.89,1:1) D WARN Q
- D RSTR,AFT^OR1,RSTR K ^TMP("XQORS",$J,0,"CTXT","ADD"),^TMP("XQORS",$J,XQORS,"CTX","AD") S (ORGY,ORACTION)=""
- D PT1^ORX2
- I $D(XRT0) S XRTN="ADD ORDERS" D T1^%ZOSV ; Stop RT Log
- I $D(ORPRFRM),$L($T(LOGRSRC^%ZOSV)) D:'$D(XQXFLG) ABT^XQ12 D:$P(XQXFLG,"^",2)=1 LOGRSRC^%ZOSV("*"_ORPRFRM) K ORPRFRM
- 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),OROLOC=$P(OROLD,"^",10)
- 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
- Q
- WARN W !,*7,"OE/RR is not installed. Options of this type should not be used.",*7,!
- Q
- VALMXQ15 ; alb/mjk - XQORO for export with LM v1 ; 3/30/93
- +1 ;;1;List Manager;;Aug 13, 1993
- +2 ;
- +3 ;
- XQORO ; SLC/KCM - Order Entry Calls ;12/14/92 09:46
- +1 ;;6.7;Sidewinder;**14,15**;Jan 08, 1993
- 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 IF $DATA(^ORD(100.99,1,0))
- IF $PIECE(^(0),"^",16)
- SET DIROUT="^^"
- WRITE !!,*7,"OE/RR Software is currently being updated. Access temporarily denied.",!
- QUIT
- +4 ; Start RT Log
- IF $DATA(XRTL)
- DO T0^%ZOSV
- +5 IF $LENGTH($TEXT(LOGRSRC^%ZOSV))
- IF XQORNOD["ORD(101,"
- IF $PIECE(^ORD(101,+XQORNOD,0),"^",4)'="M"
- IF $PIECE(^(0),"^",4)'="Q"
- IF '$DATA(XQXFLG)
- DO ABT^XQ12
- IF $PIECE(XQXFLG,"^",2)=1
- SET ORPRFRM="*"_$PIECE(^ORD(101,+XQORNOD,0),"^")
- DO LOGRSRC^%ZOSV("*"_ORPRFRM)
- +6 SET XQORQUIT=1
- IF '$DATA(ORACTION)
- QUIT
- IF ORACTION
- QUIT
- SET (ORGY,ORACTION,OREND)=0
- +7 DO ADD^OR1
- IF OREND!$DATA(ORPTLK)
- SET OREND=0
- QUIT
- +8 SET ^TMP("XQORS",$JOB,0,"CTXT","ADD")=XQORS
- SET ^TMP("XQORS",$JOB,XQORS,"CTX","AD")=""
- +9 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 IF $DATA(^ORD(100.99,1,0))
- IF $PIECE(^(0),"^",16)
- SET DIROUT="^^"
- WRITE !!,*7,"OE/RR Software is currently being updated. Access temporarily denied.",!
- QUIT
- +4 KILL ORIFN,ORCOST,ORIT,ORSTRT,ORSTOP,ORTO,ORPURG,ORTX,ORSTS,ORPK,ORLOG,ORPCL,OR,ORZ,ORNS
- +5 DO RSTR
- IF $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^")="Q"
- IF ($GET(^ORD(101,+XQORNOD,26))'["^OR")
- SET XQORM("H")="S ORUIEN=XQORNOD D OE^ORUHDR K ORUIEN"
- IF $LENGTH($TEXT(^ORGKEY))
- DO SET^ORGKEY
- +6 ;I "OL"[$P(^TMP("XQORS",$J,XQORS,"FLG"),"^") S X="(for "_ORPNM_")" W !?(40-($L(X)\2)),X
- +7 IF $PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^",3)
- IF "OL"[$PIECE(^TMP("XQORS",$JOB,XQORS,"FLG"),"^")
- IF $PIECE(^ORD(100.99,1,0),"^",11)
- WRITE !!,"<Orders for ",ORPNM,">"
- +8 IF $DATA(@(^TMP("XQORS",$JOB,XQORS,"REF")_"0)"))
- SET ORNS=$PIECE(^(0),"^",12)
- SET ORTX=$PIECE(^(0),"^",2)
- +9 IF $SELECT(ORNS:$SELECT($DATA(^ORD(100.99,1,20,ORNS,0)):$SELECT($PIECE(^(0),"^",2):0,1:1),$DATA(^ORD(100.99,1,5,ORNS,0)):$SELECT($PIECE(^(0),"^",3):0,1:1),1:1),1:1)
- WRITE *7,!,"This item is not setup to order from OE/RR",!,"(Package not setup)"
- SET XQORQUIT=1
- DO READ^ORUTL
- QUIT
- +10 IF ORNS
- IF '$DATA(ORUP(ORNS))
- SET ORUP(ORNS)=""
- IF $DATA(^ORD(100.99,1,5,ORNS,3))
- IF $LENGTH(^(3))
- XECUTE ^(3)
- +11 SET OREND=0
- KILL ORNS
- +12 QUIT
- EXIT ;When done adding, accept orders and transact them
- +1 NEW XRTN
- +2 IF $SELECT($DATA(^DD(100,0,"VR")):^("VR")<1.89,1:1)
- DO WARN
- QUIT
- +3 DO RSTR
- DO AFT^OR1
- DO RSTR
- KILL ^TMP("XQORS",$JOB,0,"CTXT","ADD"),^TMP("XQORS",$JOB,XQORS,"CTX","AD")
- SET (ORGY,ORACTION)=""
- +4 DO PT1^ORX2
- +5 ; Stop RT Log
- IF $DATA(XRT0)
- SET XRTN="ADD ORDERS"
- DO T1^%ZOSV
- +6 IF $DATA(ORPRFRM)
- IF $LENGTH($TEXT(LOGRSRC^%ZOSV))
- IF '$DATA(XQXFLG)
- DO ABT^XQ12
- IF $PIECE(XQXFLG,"^",2)=1
- DO LOGRSRC^%ZOSV("*"_ORPRFRM)
- KILL ORPRFRM
- +7 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)
- SET OROLOC=$PIECE(OROLD,"^",10)
- +1 SET OROLOC=$SELECT($LENGTH($PIECE(OROLD,"^",10)):$PIECE(OROLD,"^",10),1:ORL)
- SET DFN=$PIECE(OROLD,"^",11)
- IF $DATA(^TMP("XQORS",$JOB,0,"CTXT","ADD"))
- SET (ORGY,ORACTION)=0
- +2 QUIT
- WARN WRITE !,*7,"OE/RR is not installed. Options of this type should not be used.",*7,!
- +1 QUIT
