source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORUS2.m@ 1042

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1ORUS2 ; slc/KCM - Process Selected Items ;11/7/90 18:21 ;
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3ADD 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)=""
4 Q
5SUB S ORBUF=$O(Y("B",+ORITM,"")) I $L(ORBUF) K Y(ORBUF),Y("B",+ORITM,ORBUF) S ORTOT=ORTOT-1
6 Q
7ADD9 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)=""
8 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
9 Q
10SUB9 W " ""'"" NOT ALLOWED ON '900' ITEMS." S ORERR=1,ORSEL="?" Q
11 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)
12 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)
13 Q
14PROC I '$L(ORITM) S ORERR=1 Q
15 I ORITM=-1 D ALL Q
16 I $P(ORITM,"^",3)=9 D @$S(ORSUB:"SUB9",1:"ADD9") Q
17 D @$S(ORSUB:"SUB",1:"ADD")
18 Q
19ALL 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")
20 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")
21 Q
22EN Q:$D(^XUTL("OR",$J,"ORU")) ;K ^XUTL("OR",$J,"ORU")
23 S ORDA=0 I $D(ORUS("M")) S X=ORUS("M"),ORND=$P(X,";",1),ORPC=$P(X,";",2)
24 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
25 Q
Note: See TracBrowser for help on using the repository browser.