- ORUS2 ; slc/KCM - Process Selected Items ;11/7/90 18:21 ;
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- ADD I $D(@(ORUS_"$P(ORITM,""^""),0)")) S X=$P(^(0),"^"),ORTOT=ORTOT+1,Y=Y+1,Y(Y)=$P(ORITM,"^")_"^"_X_"^"_$P(ORITM,"^",2)_"^"_ORWRK_ORFLG,Y("B",$P(ORITM,"^"),Y)=""
- Q
- SUB S ORBUF=$O(Y("B",+ORITM,"")) I $L(ORBUF) K Y(ORBUF),Y("B",+ORITM,ORBUF) S ORTOT=ORTOT-1
- Q
- ADD9 S ORT9=ORT9+1 S:+ORITM=999 ORMOR=1,P=P+1 I +ORITM=998 S OROTHER=1,OR9Y=OR9Y+1,OR9Y(OR9Y)=$P(OR9(998),"^"),OR9Y("B",998,OR9Y)=""
- I +ORITM'=999,+ORITM'=998 S OR9Y=OR9Y+1,OR9Y(OR9Y)=$P(OR9(+ORITM),"^"),OR9Y("B",+ORITM,OR9Y)="" S X=OR9(+ORITM),X=$P(X,"^",3,99) I $L(X) X X
- Q
- SUB9 W " ""'"" NOT ALLOWED ON '900' ITEMS." S ORERR=1,ORSEL="?" Q
- S ORT9=ORT9-1 S:+ORITM=999 ORMOR=0 I +ORITM=998 S OROTHER=0,ORBUF=$O(OR9Y("B",998,"")) I $L(ORBUF) K OR9Y(ORBUF),OR9Y("B",+ORITM,ORBUF)
- I +ORITM'=999,+ORITM'=998 S X=OR9(+ORITM),X=$P(X,"^",4) X:$L(X) X S ORBUF=$O(OR9Y("B",+ORITM,"")) K:$L(ORBUF) OR9Y(ORBUF),OR9Y("B",+ORITM,ORBUF)
- Q
- PROC I '$L(ORITM) S ORERR=1 Q
- I ORITM=-1 D ALL Q
- I $P(ORITM,"^",3)=9 D @$S(ORSUB:"SUB9",1:"ADD9") Q
- D @$S(ORSUB:"SUB",1:"ADD")
- Q
- ALL I 'OREN S A="" F I=0:0 S A=$O(@(OROD_"A)")) Q:A="" S B="" F I=0:0 S B=$O(@(OROD_"A,B)")) Q:B="" I $D(@(ORUS_"B,0)")) S ORDA=B X ORSC I $T,$D(@(ORUS_"B,0)")) X ORWR I $L(X) S ORITM=ORDA_"^"_X D @$S(ORSUB:"SUB",1:"ADD")
- I OREN S B=0 F I=0:0 S B=$O(@(ORUS_"B)")) Q:B="" I $D(@(ORUS_"B,0)")) S ORDA=B X ORSC I $T,$D(@(ORUS_"B,0)")) X ORWR I $L(X) S ORITM=ORDA_"^"_X D @$S(ORSUB:"SUB",1:"ADD")
- Q
- EN Q:$D(^XUTL("OR",$J,"ORU")) ;K ^XUTL("OR",$J,"ORU")
- S ORDA=0 I $D(ORUS("M")) S X=ORUS("M"),ORND=$P(X,";",1),ORPC=$P(X,";",2)
- F I=0:0 S ORDA=$O(@(ORUS_"ORDA)")) Q:ORDA="" I $D(^(ORDA,0)) X ORSC I $T,$D(@(ORUS_"ORDA,0)")) X ORWR S ^XUTL("OR",$J,"ORU",X,ORDA)="" I $D(ORUS("M")),$D(@(ORUS_"ORDA,ORND)")) S X=$P(^(ORND),"^",ORPC) I $L(X) S ^XUTL("OR",$J,"ORU",X,ORDA)=1
- Q
- ORUS2 ; slc/KCM - Process Selected Items ;11/7/90 18:21 ;
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- ADD IF $DATA(@(ORUS_"$P(ORITM,""^""),0)"))
- SET X=$PIECE(^(0),"^")
- SET ORTOT=ORTOT+1
- SET Y=Y+1
- SET Y(Y)=$PIECE(ORITM,"^")_"^"_X_"^"_$PIECE(ORITM,"^",2)_"^"_ORWRK_ORFLG
- SET Y("B",$PIECE(ORITM,"^"),Y)=""
- +1 QUIT
- SUB SET ORBUF=$ORDER(Y("B",+ORITM,""))
- IF $LENGTH(ORBUF)
- KILL Y(ORBUF),Y("B",+ORITM,ORBUF)
- SET ORTOT=ORTOT-1
- +1 QUIT
- ADD9 SET ORT9=ORT9+1
- IF +ORITM=999
- SET ORMOR=1
- SET P=P+1
- IF +ORITM=998
- SET OROTHER=1
- SET OR9Y=OR9Y+1
- SET OR9Y(OR9Y)=$PIECE(OR9(998),"^")
- SET OR9Y("B",998,OR9Y)=""
- +1 IF +ORITM'=999
- IF +ORITM'=998
- SET OR9Y=OR9Y+1
- SET OR9Y(OR9Y)=$PIECE(OR9(+ORITM),"^")
- SET OR9Y("B",+ORITM,OR9Y)=""
- SET X=OR9(+ORITM)
- SET X=$PIECE(X,"^",3,99)
- IF $LENGTH(X)
- XECUTE X
- +2 QUIT
- SUB9 WRITE " ""'"" NOT ALLOWED ON '900' ITEMS."
- SET ORERR=1
- SET ORSEL="?"
- QUIT
- +1 SET ORT9=ORT9-1
- IF +ORITM=999
- SET ORMOR=0
- IF +ORITM=998
- SET OROTHER=0
- SET ORBUF=$ORDER(OR9Y("B",998,""))
- IF $LENGTH(ORBUF)
- KILL OR9Y(ORBUF),OR9Y("B",+ORITM,ORBUF)
- +2 IF +ORITM'=999
- IF +ORITM'=998
- SET X=OR9(+ORITM)
- SET X=$PIECE(X,"^",4)
- IF $LENGTH(X)
- XECUTE X
- SET ORBUF=$ORDER(OR9Y("B",+ORITM,""))
- IF $LENGTH(ORBUF)
- KILL OR9Y(ORBUF),OR9Y("B",+ORITM,ORBUF)
- +3 QUIT
- PROC IF '$LENGTH(ORITM)
- SET ORERR=1
- QUIT
- +1 IF ORITM=-1
- DO ALL
- QUIT
- +2 IF $PIECE(ORITM,"^",3)=9
- DO @$SELECT(ORSUB:"SUB9",1:"ADD9")
- QUIT
- +3 DO @$SELECT(ORSUB:"SUB",1:"ADD")
- +4 QUIT
- ALL IF 'OREN
- SET A=""
- FOR I=0:0
- SET A=$ORDER(@(OROD_"A)"))
- IF A=""
- QUIT
- SET B=""
- FOR I=0:0
- SET B=$ORDER(@(OROD_"A,B)"))
- IF B=""
- QUIT
- IF $DATA(@(ORUS_"B,0)"))
- SET ORDA=B
- XECUTE ORSC
- IF $TEST
- IF $DATA(@(ORUS_"B,0)"))
- XECUTE ORWR
- IF $LENGTH(X)
- SET ORITM=ORDA_"^"_X
- DO @$SELECT(ORSUB:"SUB",1:"ADD")
- +1 IF OREN
- SET B=0
- FOR I=0:0
- SET B=$ORDER(@(ORUS_"B)"))
- IF B=""
- QUIT
- IF $DATA(@(ORUS_"B,0)"))
- SET ORDA=B
- XECUTE ORSC
- IF $TEST
- IF $DATA(@(ORUS_"B,0)"))
- XECUTE ORWR
- IF $LENGTH(X)
- SET ORITM=ORDA_"^"_X
- DO @$SELECT(ORSUB:"SUB",1:"ADD")
- +2 QUIT
- EN ;K ^XUTL("OR",$J,"ORU")
- IF $DATA(^XUTL("OR",$JOB,"ORU"))
- QUIT
- +1 SET ORDA=0
- IF $DATA(ORUS("M"))
- SET X=ORUS("M")
- SET ORND=$PIECE(X,";",1)
- SET ORPC=$PIECE(X,";",2)
- +2 FOR I=0:0
- SET ORDA=$ORDER(@(ORUS_"ORDA)"))
- IF ORDA=""
- QUIT
- IF $DATA(^(ORDA,0))
- XECUTE ORSC
- IF $TEST
- IF $DATA(@(ORUS_"ORDA,0)"))
- XECUTE ORWR
- SET ^XUTL("OR",$JOB,"ORU",X,ORDA)=""
- IF $DATA(ORUS("M"))
- IF $DATA(@(ORUS_"ORDA,ORND)"))
- SET X=$PIECE(^(ORND),"^",ORPC)
- IF $LENGTH(X)
- SET ^XUTL("OR",$JOB,"ORU",X,ORDA)=1
- +3 QUIT
